home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mpl17ds.zip / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1989-04-24  |  145KB  |  3,943 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS CPC17-1D, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: September 18, 1988
  7. '  Subsequent Releases.: OCT 30 , 1988
  8. '  Copyright ..........: 1986, 1987, 1988
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        Those that do not require error trapping are
  12. '                        incorporated within RBBSSUB2.BAS, RBBSSUB3.BAS,
  13. '                        RBBSSUB4.BAS and RBBSSUB5.BAS as separately
  14. '                        callable subroutines in order to free up as much
  15. '                        code as possible within the 64K code segment
  16. '                        used by RBBS-PC.BAS.
  17. '  Parameters..........: Most parameters are passed via a COMMON statement.
  18. '
  19. ' Subroutine  Line               Function of Subroutine
  20. '   Name     Number
  21. '  ANSWERIT     201   Answer the telephone when it rings
  22. '  ASCCODES     129   Allow a CONFIG string to have any ASCII value
  23. '  BADCHAR      455   Check user name for invalid characters
  24. '  BADNAME    20235   Check for system crash attempt with bad file name
  25. '  BAUD450     5507   Allow 300 baud callers to bump up to 450 baud
  26. '  BRKFNAME   20282   Break a file name into it's component parts
  27. '  CHECKRATIO 20096   Test upload/download ratio
  28. '  CHKMACRO    1242   Checks for macro and processes
  29. '  COPYWRIT      97   Display RBBS-PC's copyright notice
  30. '  DEFALTU     9600   Write out the user's defaults
  31. '  DENYACCESS  1386   Downgrade security so access denied
  32. '  DOOREXIT   10987   Set up a .BAT file to exit RBBS-PC and go to a "door"
  33. '  DOSEXIT    10934   Set up a .BAT file to exit to DOS (second level)
  34. '  EDITALINE   2620   Edits a single line
  35. '  EDITDEF            Edit configuration parameters
  36. '  GETARC     20141   Handle request for verbose arc listing
  37. '  GETCOMND      97+  Get RBBS-PC's node id from command line
  38. '  GETIME      9140   Calculates callers elapsed time (hours, minutes, seconds)
  39. '  GOIDLE        90   Release resources when waiting for keyboard input
  40. '  KILLMSG     3955   Delete old or unnecessary messages
  41. '  LINE25       949   Build and/or update line 25 of RBBS-PC's local screen
  42. '  LINEEDIT    3700   Edit a line while minimizing string space consumption
  43. '  LOGERROR   13660   Log error message to CALLERS file
  44. '  LPRNT       1480   Subroutine to write to local display
  45. '  MLINIT        10   Handle MultiLink initialization/de-initialization
  46. '  MSGPROT     2060   Sets protection for a message
  47. '  MSGTO       2020   Sets who a message is to
  48. '  PAGLEN      5902   Change page length
  49. '  PARSEIT     1635   Parses a string
  50. '  PASSWRD      667   Verify user & message passwords
  51. '  PSCRN       1480+  Print to display
  52. '  QTPUT       1477   Fast, but limited, "TPUT" equivalent
  53. '  RBBSEXIT   10992   Common RBBS-PC exit to transfer control to other programs
  54. '  RECOVMSG   10410   Recover a deleted message
  55. '  REMNONALF   5100   Removes non-alpha characters from a string
  56. '  RINGCALLER  1635+  Ring caller's bell and put message in emphasis
  57. '  SETBAUD     1654   Set baud rate in the 8250 chip of the RS232 interface
  58. '  SETCRLF     1496   Set up the necessary carriage return/line feed string
  59. '  SETSECT    12000   Set the proper section prompts (main, file, util, libr)
  60. '  SETTHREAD   4031   Set up request for threading thru messages
  61. '  SKIPLINE    1485   Write a # of blank lines to the communications port
  62. '  SRCHCMND    1240   Searches list of commands in RBBS for a request
  63. '  SVIOLATION  1380   Process a security violation
  64. '  SYSMENU      112   Displays sysop menu/status
  65. '  SYSOPCHAT   4657   Sysop and caller chat                          ' KG102206
  66. '  TESTREL      336   Tests for Reliable connect
  67. '  TGET        1500   Read a line from the communications port
  68. '  TPUT        1400   Write a line to the communications port
  69. '  TRIM          99   Strip leading and trailing blanks from a string
  70. '  TRIMTRAIL     99   Strip off specified string off end of another string
  71. '  UNTILRIGHT 12880   Ask a question until user says answer is right
  72. '  UPDATEU    10600   Updates the user record on loging off/exiting RBBS-PC
  73. '  VARINIT      104   Initialize system variables
  74. '  VIEWHELP    1330   Processes help command
  75. '  WHOCHECK    2250   Checks whether a user exists in user file
  76. '  WHOSON      9801   Report status of each node - who's on
  77. '  WILDCARD   20285   Determines whether string matches a pattern
  78. '  WORDINFILE 10976   Find a whole word within a file/menu
  79. '
  80. '  $INCLUDE: 'RBBS-VAR.BAS'
  81. '
  82. '  $SUBTITLE: 'MLINIT - MultiLink initialization/deinitialization'
  83. '  $PAGE
  84. '
  85. '  SUBROUTINE NAME    -- MLINIT
  86. '
  87. '  INPUT PARAMETERS   --  MLPARM = 1             INITIALIZE AT STARTUP OR RE-
  88. '                                                CYLCE TIME
  89. '                         MLPARM = 2             DE-INITIALIZE ON EXITING TO
  90. '                                                A DOOR OR DOS REMOTELY
  91. '                         MLPARM = 3             DE-QUEUE COMMUNICATIONS PORTS
  92. '                         MLPARM = 4             CHECK FOR MULTILINK PRESENT
  93. '                         DOORS.TERMINAL.TYPE
  94. '                         BAUD.TEST
  95. '                         COM.PORT$
  96. '                         COMPUTER.TYPE
  97. '
  98. '  OUTPUT PARAMETERS  --  NONE
  99. '
  100. '  SUBROUTINE PURPOSE --  TO TEST FOR THE PRESENCE OF MULTI-LINK AND SET
  101. '                         MULTI LINK OPTIONS TO BE COMPATIBLE WITH RBBS-PC
  102. '
  103.       SUB MLINIT (MLPARM) STATIC
  104.     DEF SEG = 0
  105.     IF COMPUTER.TYPE = 1 _
  106.        GOTO 10
  107.     IF NOT MLCOM THEN _
  108.        IF NETWORK.TYPE <> 1 THEN _
  109.           GOTO 10
  110.     MULTI.LINK.PRESENT = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  111.     IF MULTI.LINK.PRESENT = 0 THEN _
  112.        GOTO 10
  113.     ON MLPARM GOSUB 30,20,60,10
  114. 10  DEF SEG
  115.     EXIT SUB
  116. 20  IF DOORS.TERMINAL.TYPE < 1 THEN _
  117.        RETURN
  118.     DEF SEG = MULTI.LINK.PRESENT
  119.     GOSUB 60
  120. ' **************     MLUTIL BAUD n (where n = BAUD.TEST)  *******
  121.     AX = &H600
  122.     BX = BAUD.TEST   ' Tell ML the baud rate
  123.     GOSUB 80
  124. ' **************     MLUTIL TERM n (where n = DOORS.TERMINAL.TYPE) *****
  125.     AX = &H700 + DOORS.TERMINAL.TYPE
  126.     GOSUB 80         ' Tell ML the terminal type
  127. ' *********          MLINK /port       ************
  128. '                    ' Tell ML the communications port
  129.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(COM.PORT$,1)) - 48
  130. ' ************       MLUTIL SCMON       **************
  131.     AX = &HB01
  132.     BX = 0           ' Tell ML to start monitoring the carrier
  133.     GOSUB 80
  134.     RETURN
  135. ' **************     MLUTIL CCMON       ****************
  136. 30  AX = &HB00       ' Turn off ML's carrier monitoring.
  137.     BX = 0
  138.     GOSUB 80
  139. ' **************     MLUTIL TERM 1       **************
  140.     AX = &H701       ' Change terminal type to ML type 1.
  141.     BX = 0
  142.     GOSUB 80
  143. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  *******
  144. ' *******            port = 0 if ML 4.00 or greater           *******
  145.     DEF SEG = MULTI.LINK.PRESENT
  146.     MULTI.LINK.COM.PORT = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  147.     MULTI.LINK.VERSION = PEEK(&H1) + 256 * PEEK(&H2)
  148.     IF PEEK(MULTI.LINK.COM.PORT) = &H1 OR _
  149.        PEEK(MULTI.LINK.COM.PORT) = &H2 THEN _
  150.        IF MULTI.LINK.VERSION > 5000 THEN _
  151.           POKE (MULTI.LINK.COM.PORT),&H0 _
  152.        ELSE POKE (MULTI.LINK.COM.PORT),&H9
  153. ' **********         MLUTIL ENQ         ***********
  154.     AX = &H1        ' Tell ML to conditional enque on the comm. port
  155.     GOSUB 70
  156. ' **********         MLUTIL BAUD 19200      **********
  157.     AX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  158.     BX = 19200
  159.     GOSUB 80
  160.     RETURN
  161. ' **********         MLUTIL DEQ         **********
  162. 60 AX = &H100        ' Tell ML to unconditionally deque the comm. port
  163. 70 BX = -4
  164.    IF COM.PORT$ = "COM2" THEN _
  165.       BX = -3
  166.    IF COM.PORT$ = "COM0" THEN _
  167.       RETURN
  168. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  ********
  169. 80 CALL RBBSML(AX,BX)
  170.    RETURN
  171.    END SUB
  172. '  $SUBTITLE: 'GOIDLE - subroutine to release control when waiting'
  173. '  $PAGE
  174. '
  175. '  SUBROUTINE NAME    -- GOIDLE
  176. '
  177. '  INPUT PARAMETERS   -- MLCOM
  178. '                        NETWORK.TYPE
  179. '
  180. '  OUTPUT PARAMETERS  --  NONE
  181. '
  182. '  SUBROUTINE PURPOSE --  TO RELINQUISH CONTROL WHEN RBBS-PC IS WAITING FOR
  183. '                         INPUT FROM THE COMMUNICATIONS PORT
  184. '
  185.       SUB GOIDLE STATIC
  186. 90 IF MLCOM OR NETWORK.TYPE = 1 THEN _
  187.       CALL MLINIT(5) : _
  188.       EXIT SUB
  189.    CALL GIVEBACK
  190.    END SUB
  191. '  $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright'
  192. '  $PAGE
  193. '
  194. '  SUBROUTINE NAME    -- COPYWRIT
  195. '
  196. '  INPUT PARAMETERS   --  NONE
  197. '
  198. '  OUTPUT PARAMETERS  --  NONE
  199. '
  200. '  SUBROUTINE PURPOSE --  TO DISPLAY RBBS-PC'S COPYRIGHT NOTICE ON THE LOCAL
  201. '                         SYSOP'S SCREEN
  202. '
  203.       SUB COPYWRIT STATIC
  204. 97 WIDTH 80,25
  205.    CLS
  206.    KEY OFF
  207.    LOCATE ,,0
  208.    SNOOP = -1
  209.    LOCAL.USER = -1
  210.    CALL LPRNT(SPACE$(5) + "Copyright (c) 1983-89 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  211.    CALL DELAYIT (1)
  212.    SNOOP = 0
  213.    END SUB
  214. ' $SUBTITLE: 'GETCOMND - subroutine to get command from command line'
  215. ' $PAGE
  216. '
  217. '  SUBROUTINE NAME    -- GETCOMND
  218. '
  219. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  220. '                        CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE TO
  221. '                                             USE AS A MODEL WHEN CREATING THE
  222. '                                             .DEF FILE NAME TO BE USED BY THIS
  223. '                                             COPY OF RBBS-PC.
  224. '
  225. '                        COMMAND LINE         COMMAND LINE USED TO INVOKE
  226. '                                             RBBS-PC IN THE FORM:
  227. '
  228. '             RBBS-PC.EXE x filename DEBUG /time /baud
  229. '
  230. '   WHERE THE OPTIONAL PARAMETERS ARE:
  231. '
  232. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  233. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  234. ' DEBUG    IS A DEBUGGING SWITCH
  235. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  236. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  237. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  238. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  239. '             PROGRAM
  240. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  241. '
  242. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  243. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  244. '
  245. '  OUTPUT PARAMETERS  -- CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE FOR
  246. '                                             THIS COPY OF RBBS-PC TO USE
  247. '                        NODE.RECORD.INDEX    RECORD NUMBER WITHIN THE
  248. '                                             MESSAGES FILE FOR THIS "NODE"
  249. '                                             (RANGE IS 2 TO 36)
  250. '
  251. '  SUBROUTINE PURPOSE --  TO GET NODE ID FROM COMMAND LINE
  252. '
  253.       SUB GETCOMND (PASSED.DEBUG,NETIME$,NETBAUD$,NETRELIABLE$) STATIC
  254.       STATIC DEBUG
  255. '
  256. ' *
  257. ' *  GET NODE ID FROM COMMAND LINE                                            *
  258. ' *
  259. '
  260.       PM$ = COMMAND$
  261.       CALL ALLCAPS(PM$)
  262.       IF INSTR(PM$,"/") = 0 THEN _
  263.          GOTO 98
  264. '
  265. ' *
  266. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL           *
  267. ' *
  268. '
  269.       CMD.LINE$ = MID$(PM$,INSTR(PM$,"/"))
  270.       PM$ = LEFT$(PM$,INSTR(PM$,"/") - 1)
  271.       A = 0
  272.       FOR X = 1 TO LEN(CMD.LINE$)
  273.           IF MID$(CMD.LINE$,X,1) = "/" THEN _
  274.              A = A + 1 : _
  275.              WORK.ARA$(A) = "" _
  276.           ELSE WORK.ARA$(A) = WORK.ARA$(A) + MID$(CMD.LINE$,X,1)
  277.       NEXT
  278.       NETIME$ = WORK.ARA$(1)
  279.       IF A > 1 THEN _
  280.          NETBAUD$ = WORK.ARA$(2)
  281.       IF A > 2 THEN _
  282.          NETRELIABLE$ = WORK.ARA$(3)
  283.       CALL TRIM(NETIME$)
  284.       CALL TRIM(NETBAUD$)
  285.       CALL TRIM(NETRELIABLE$)
  286. 98    A = INSTR(PM$,"DEBUG")
  287.       IF A > 0 THEN _
  288.          DEBUG = -1 : _
  289.          PM$ = LEFT$(PM$,A - 1) + _
  290.                RIGHT$(PM$,LEN(PM$) - A - 4)
  291.       PASSED.DEBUG = DEBUG
  292.       IF LEN(PM$) = 0 THEN _
  293.          PM$ = "-"
  294.       NODE.RECORD.INDEX = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(PM$,1))
  295.       IF NODE.RECORD.INDEX < 2 THEN _
  296.          NODE.RECORD.INDEX = 2
  297.       NODE.ID$ = MID$(STR$(NODE.RECORD.INDEX-1),2)
  298.       IF NODE.RECORD.INDEX > 10 THEN _                'KG110201
  299.          NODE.FILE.ID$ = LEFT$(PM$,1) _
  300.       ELSE NODE.FILE.ID$ = NODE.ID$
  301.       IF NODE.ID$ <> "1" THEN _
  302.          LIBRARY.NODE.ID$ = NODE.FILE.ID$
  303.       IF LEN(PM$) > 2 AND MID$(PM$,2,1) = " " THEN _
  304.          CONFIG.FILENAME$ = MID$(PM$,3)_
  305.       ELSE MID$(CONFIG.FILENAME$,5,1) = PM$
  306.       ORIG.CONFIG$ = CONFIG.FILENAME$
  307.       END SUB
  308. ' $SUBTITLE: 'TRIM - subroutine to eliminate leading/trailing blanks'
  309. ' $PAGE
  310. '
  311. '  SUBROUTINE NAME    -- TRIM
  312. '
  313. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  314. '                        TRIM.PARM$           STRING THAT IS TO HAVE LEADING
  315. '                                             AND TRAILING BLANKS ELIMINATED
  316. '                                             FROM
  317. '
  318. '  OUTPUT PARAMETERS  -- TRIM.PARM$           STRING WITH NO LEADING OR TRAIL-
  319. '                                             ING BLANKS
  320. '
  321. '  SUBROUTINE PURPOSE --  TO STRIP LEADING AND TRAILING BLANKS
  322. '
  323.       SUB TRIM (TRIM.PARM$) STATIC
  324. 99    L = INSTR(TRIM.PARM$," ")
  325.       IF L < 1 THEN _
  326.          EXIT SUB
  327.       IF L = 1 THEN _
  328.          WHILE LEFT$(TRIM.PARM$,1) = " " : _
  329.             TRIM.PARM$ = RIGHT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1) : _
  330.          WEND
  331.       CALL TRIMTRAIL (TRIM.PARM$," ")
  332.       END SUB
  333. '
  334. '  $SUBTITLE: 'TRIMTRAIL - subroutine to trim off trailing characters'
  335. '  $PAGE
  336. '
  337. '  SUBROUTINE NAME    --  TRIMTRAIL
  338. '
  339. '  INPUT PARAMETERS   --  PARAMETER           MEANING
  340. '                         TRIM.PARM$  TIME IN SECONDS AFTER MIDNIGHT TO WAIT
  341. '                                     BEFORE DISPLAYING
  342. '                         TRIM.THIS$  WHAT CHARACTER TO TRIM OFF END
  343. '
  344. '  OUTPUT PARAMETERS  --  NONE
  345. '
  346. '  SUBROUTINE PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  347. '
  348.       SUB TRIMTRAIL (TRIM.PARM$,TRIM.THIS$) STATIC
  349.       WHILE RIGHT$(TRIM.PARM$,1) = TRIM.THIS$
  350.          TRIM.PARM$ = LEFT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1)
  351.       WEND
  352.       END SUB
  353. '
  354. '  $SUBTITLE: 'VARINIT - subroutine to initialize system variables'
  355. '  $PAGE
  356. '
  357. '  SUBROUTINE NAME    --  VARINIT
  358. '
  359. '  INPUT PARAMETERS   --  PARAMETER           MEANING
  360. '                         NONE
  361. '
  362. '  OUTPUT PARAMETERS  --  NONE
  363. '
  364. '  SUBROUTINE PURPOSE --  TO INITIAIZE SYSTEM VARIABLES
  365. '
  366.       SUB VARINIT STATIC
  367. 104 ACKNOWLEDGE$ = CHR$(6)
  368.     ACKC$ = "C" + _
  369.             ACKNOWLEDGE$
  370.     ACTIVE.MENU$ = "B"
  371.     ACTIVE.MESSAGE$ = CHR$(225)
  372.     BACKSPACE$ = CHR$(8) + _
  373.                  CHR$(32) + _
  374.                  CHR$(8)
  375.     BACK.ARROW$ = CHR$(29) + _
  376.                   CHR$(32) + _
  377.                   CHR$(29)
  378.     BELL.RINGER$ = CHR$(7)
  379.     BULLETIN.MENU$ = ""
  380.     C.L = 24
  381.     CANCEL$ = CHR$(24)
  382.     COLOR.RESET$ = CHR$(27) + _
  383.                    "[00;37;40m"
  384.     CONFIG.FILENAME$ = "RBBS-PC.DEF"
  385.     CARRIAGE.RETURN$ = CHR$(13)
  386.     DELETED.MESSAGE$ = CHR$(226)
  387.     DOS.VERSION = 2
  388.     END.TRANSMISSION$ = CHR$(4)
  389.     ESCAPE$ = CHR$(27)
  390.     EXPECT.ACTIVE.MODEM = 0
  391.     FALSE = 0
  392.     F1.KEY = 59
  393.     F10.KEY = 68
  394.     GRN$ = "MAIN"
  395.     CALL SETHILITE (TRUE)
  396.     HOME.CONFERENCE$ = ""
  397.     IN.CONF.MENU = -1
  398.     LIMIT.MINUTES.PER.SESSION! = 0
  399.     LINE.FEED$ = CHR$(10)
  400.     LINE.FEEDS = NOT FALSE
  401.     LINEEDIT.CHK$ = CHR$(9) + _
  402.                     LINE.FEED$ + _
  403.                     CHR$(11) + _
  404.                     CHR$(12) + _
  405.                     CHR$(127) + _
  406.                     CHR$(8) + _
  407.                     BELL.RINGER$ + _
  408.                     CHR$(26) + _
  409.                     CHR$(227)
  410.     LINEMES$ = SPACE$(78)          ' fixed length string workspace
  411.     LOCK.STATUS$ = "UM UU UB UD"
  412.     MENU.INDEX = 2
  413.     NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  414.     NO.ADVANCE = FALSE
  415.     PAGE.LENGTH = 23
  416.     PARSE.OFF = FALSE
  417.     PRESS.ENTER$ = " (Press [ENTER] to quit)"
  418.     PRESS.ENTER.EXPERT$ = " ([ENTER] quits)"
  419.     PRESS.ENTER.NOVICE$ = PRESS.ENTER$
  420.     PRIVATE.DOOR = FALSE
  421.     RIGHT.MARGIN = 72
  422.     RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + _
  423.                         LINE.FEED$
  424.     SMART.TABLE$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  425.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL NT"        'BK012901
  426.     START.OF.HEADER$ = CHR$(1)
  427.     TIME.LOGGED.ON$ = SPACE$(8)
  428.     TRUE = NOT FALSE
  429.     UPINC = -1
  430.     XOFF$ = CHR$(19)
  431.     XON$ = CHR$(17)
  432.     INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$
  433.     OPTION.END$ = RETURN.LINE.FEED$ + " ,("
  434.     CRLF$ = CARRIAGE.RETURN$ + LINE.FEED$
  435.     LG$(1) = "Registration Check Failed"
  436.     LG$(2) = "Sysop name attempted"
  437.     LG$(3) = "Locked out attempt"
  438.     LG$(4) = "Password Attempt Failed"
  439.     LG$(5) = "Auto Lockout done"
  440.     LG$(6) = "Name in use on another Node!"
  441.     LG$(7) = ""
  442.     LG$(8) = "Locked reason read!"
  443.     LG$(9) = "Expired Registration"
  444.     END SUB
  445. '
  446. '  $SUBTITLE: 'SYSMENU - subroutine to display RBBS-PC SYSOP menu'
  447. '  $PAGE
  448. '
  449. '  SUBROUTINE NAME    --  SYSMENU
  450. '
  451. '  INPUT PARAMETERS   --  PARAMETER           MEANING
  452. '                           DELAY!    TIME IN SECONDS AFTER MIDNIGHT TO WAIT
  453. '                                     BEFORE DISPLAYING
  454. '
  455. '  OUTPUT PARAMETERS  --  NONE
  456. '
  457. '  SUBROUTINE PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  458. '
  459.     SUB SYSMENU STATIC
  460.     DELAY! = 0
  461. 112 LOCAL.USER = TRUE
  462.     SNOOP = TRUE
  463.     NON.STOP = TRUE
  464.     SUBROUTINE.PARAMETER = 1
  465.     WHILE SUBROUTINE.PARAMETER = 1
  466.        CALL CHECKTIM (DELAY!)
  467.     WEND
  468.     CLS
  469.     STOP.INTERRUPTS = TRUE
  470.     BYPASS.TIME.CHECK = TRUE
  471.     CALL BUFFILE ("MENU0",X)
  472.     NON.STOP = FALSE
  473.     BYPASS.TIME.CHECK = FALSE
  474.     LOCAL.USER = FALSE
  475.     IF NOT OK THEN _
  476.        CALL LPRNT("MENU0 not on default drive",1)
  477.     LOCATE 2,18
  478.     CALL LPRNT(LEFT$(VERSION.ID$,8),0)
  479.     LOCATE 2,42
  480.     CALL LPRNT(NODE.ID$,0)
  481.     LOCATE 2,60
  482.     X$ = DATE$
  483.     CALL LPRNT(LEFT$(X$,6) + RIGHT$(X$,2),0)
  484.     LOCATE 2,74
  485.     CALL LPRNT(LEFT$(TIME$,5),0)
  486.     IF FMS.DIRECTORY$ <> "" THEN _
  487.        LOCATE 6,76 : _
  488.        CALL LPRNT("YES",0)
  489.     IF EXTENDED.LOGGING THEN _
  490.        LOCATE 8,76 : _
  491.        CALL LPRNT("YES",0)
  492.     IF FOSSIL THEN _
  493.        LOCATE 10,76 : _
  494.        CALL LPRNT("YES",0)
  495.     LOCATE 12,75 : _
  496.     CALL LPRNT(COM.PORT$,0)
  497.     LOCATE 14,75
  498.     CALL LPRNT (STR$(CINT(FRE("A")/1024)) + "k",0)
  499.     IF DEBUG THEN _
  500.        LOCATE 22,76 : _
  501.        CALL LPRNT("Yes",0)
  502.     END SUB
  503. '
  504. '  $SUBTITLE: 'EDITDEF - subrotuine to edit config parameters'
  505. '  $PAGE
  506. '
  507. '  SUBROUTINE NAME    -- EDITDEF
  508. '
  509. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  510. '
  511. '  OUTPUT PARAMETERS  --                          OUTPUT STRING
  512. '
  513. '  SUBROUTINE PURPOSE -- Interpretes and adjusts stored configuration
  514. '                        parameters
  515. '
  516. 120   SUB EDITDEF STATIC
  517.       ALL.OPTS$ = MAIN.COMMANDS$ + _
  518.                   FILE.COMMANDS$ + _
  519.                   UTIL.COMMANDS$ + _
  520.                   LIBRARY.COMMANDS$ + _
  521.                   GLOBAL.COMMANDS$ + _
  522.                   SYSOP.COMMANDS$
  523.       HELP.EXTENSION$ = "." + _
  524.                         HELP.EXTENSION$
  525.       BEG.MAIN = 1
  526.       BEG.FILE = LEN(MAIN.COMMANDS$) + BEG.MAIN
  527.       BEG.UTIL = LEN(FILE.COMMANDS$) + BEG.FILE
  528.       BEG.LIBRARY = LEN(UTIL.COMMANDS$) + BEG.UTIL
  529.       HELP$(3) = HELP.PATH$ + _
  530.                  HELP$(3)
  531.       HELP$(4) = HELP.PATH$ + _
  532.                  HELP$(4)
  533.       HELP$(7) = HELP.PATH$ + _
  534.                  HELP$(7)
  535.       HELP$(9) = HELP.PATH$ + _
  536.                  HELP$(9)
  537.       CALL BRKFNAME (WELCOME.FILE$,WELCOME.FILE.DRV.PATH$,PREFIX$,_
  538.                      EXTENSION$,TRUE)
  539.      CALL ASCCODES ("[","]",DEFAULT.LINE.ACK$)
  540.      CALL ASCCODES ("[","]",HOST.ECHO.ON$)
  541.      CALL ASCCODES ("[","]",HOST.ECHO.OFF$)
  542.      PERSONAL.DIR$ = PERSONAL.DRVPATH$ + _
  543.                      PERSONAL.DIR$
  544.      CALL ASCCODES ("[","]",EMPHASIZE.OFF.DEF$)
  545.      CALL ASCCODES ("[","]",EMPHASIZE.ON.DEF$)
  546.      DR.1$ = FG.1.DEF$
  547.      DR.2$ = FG.2.DEF$
  548.      DR.3$ = FG.3.DEF$
  549.      DR.4$ = FG.4.DEF$
  550.      IF SUBROUTINE.PARAMETER = -62 THEN _
  551.         EXIT SUB
  552.      LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1")                   ' KG110502
  553.      IF LOCAL.USER.MODE THEN _                                       ' KG110502
  554.         RECYCLE.TO.DOS = TRUE                                        ' KG110502
  555.      ECHOER$ = DEFAULT.ECHOER$
  556.      SMART.TEXT$ = CHR$(SMART.TEXT)
  557. '
  558. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***                           *
  559. '
  560.     IF MAIN.FMS.DIRECTORY$ <> "" THEN _
  561.        FMS.DIRECTORY$ = DIRECTORY.PATH$ + _
  562.                         MAIN.FMS.DIRECTORY$ + _
  563.                         "." + _
  564.                         MAIN.DIRECTORY.EXTENTION$ : _
  565.        ACTIVE.FMS.DIRECTORY$ = FMS.DIRECTORY$ : _                    ' KG121902
  566.        LIBRARY.DIRECTORY$ = LIBRARY.DIRECTORY.PATH$ + _
  567.                             MAIN.FMS.DIRECTORY$ + _
  568.                             "." + _
  569.                             LIBRARY.DIRECTORY.EXTENTION$
  570.     UPCAT.HELP$ = HELP.PATH$ + _
  571.                   UPCAT.HELP$ + _
  572.                   HELP.EXTENSION$
  573.     IF SUBDIR.COUNT < 1 THEN _
  574.        GOTO 123
  575.     FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
  576.        INPUT #2,SUBDIR$
  577.        IF RIGHT$(SUBDIR$,1) <> "\" THEN _
  578.          SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + _
  579.                                  "\" _
  580.        ELSE SUBDIR$(SUBDIR.INDEX) = SUBDIR$
  581.     NEXT
  582.     GOTO 125
  583. 123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
  584.        SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + _
  585.                                ":"
  586.     NEXT
  587.     SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
  588. '
  589. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ****
  590. '
  591. 125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$
  592.     SUBDIR.COUNT = SUBDIR.COUNT + 1
  593.     IF UPLOAD.TO.SUBDIR THEN _
  594.        SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + _
  595.                                "\" _
  596.     ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
  597.                                  ":"
  598.     UPLOAD.DIRECTORY$ = UPLOAD.DIRECTORY$ + _
  599.                         "." + _
  600.                         MAIN.DIRECTORY.EXTENTION$
  601.     CALL CHKNARY (SUBDIR$(SUBDIR.COUNT),SUBDIR$(),SUBDIR.COUNT-1,FOUND)
  602.     CAN.DOWNLOAD.FROM.UP = (FOUND > 0)
  603.     UPLOAD.DIRECTORY$ = UPLOAD.PATH$ + _
  604.                         UPLOAD.DIRECTORY$
  605. 126 CLOSE #2
  606.     IF LIBRARY.DRIVE$ <> "" THEN _
  607.        LIBRARY.TYPE = 1
  608.     SUBROUTINE.PARAMETER = -10
  609.     CALL CARRIER
  610.     IF SUBROUTINE.PARAMETER = -1 THEN _
  611.        IF LIBRARY.DRIVE$ <> "" THEN _
  612.           CALL CHANGEDIR (LIBRARY.DRIVE$ + _
  613.                          "\") : _
  614.           CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  615.                         LIBRARY.NODE.ID$ + _
  616.                         "DK*.ARC") : _
  617.                         EC = 0
  618. '
  619. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***                         *
  620. '
  621. 128 IF NETWORK.TYPE = 2 THEN _
  622.        CN$ = SPACE$(535) : _
  623.        CALL INITIO(A)
  624.        END SUB
  625. '
  626. '  $SUBTITLE: 'ASCCODES - subrotuine to allow any ASCII codes'
  627. '  $PAGE
  628. '
  629. '  SUBROUTINE NAME    -- ASCCODES
  630. '
  631. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  632. '                           LEFT.PAREN$           MARKS BEGINNING OF #
  633. '                           RIGHT.PAREN$          MARKS END OF #
  634. '                           STRNG$                INPUT STRING
  635. '
  636. '  OUTPUT PARAMETERS  --    STRNG$                OUTPUT STRING
  637. '
  638. '  SUBROUTINE PURPOSE -- TO ALLOW A CONFIG STRING TO HAVE ANY ASCII VALUES.
  639. '                        CHARACTERS NOT ENCLOSED TAKEN AS IS.  ENCLOSED
  640. '                        CHARACTERS INTERPRETED AS VALUE OF ASCII CODE.
  641. '                        (I.E. "123[32]4" IS INTERPRETED AS "123 4").
  642. '
  643. 129 SUB ASCCODES (LEFT.PAREN$,RIGHT.PAREN$,STRNG$) STATIC
  644.     IF LEN(STRNG$) < 1 THEN _
  645.        EXIT SUB
  646.     STRT = 1
  647.     L = LEN(STRNG$)
  648.     B$ = STRNG$ + _
  649.          LEFT.PAREN$
  650.     X = INSTR(B$,LEFT.PAREN$)
  651.     NEW.STRNG$ = ""
  652.     WHILE STRT <= L
  653.        NEW.STRNG$ = NEW.STRNG$ + _
  654.                     MID$(B$,STRT,X - STRT)
  655.        Y = INSTR(X,B$,RIGHT.PAREN$)
  656.        IF Y > 0 THEN _
  657.           K = VAL(MID$(B$,X + 1,Y - X - 1)) : _
  658.           NEW.STRNG$ = NEW.STRNG$ + _
  659.                        CHR$(K) : _
  660.           STRT = Y + 1 _
  661.        ELSE NEW.STRNG$ = NEW.STRNG$ + _
  662.                          MID$(B$,X,L + 1 - X) : _
  663.             STRT = L + 1
  664.        X = INSTR(STRT,B$,LEFT.PAREN$)
  665.     WEND
  666.     STRNG$ = NEW.STRNG$
  667.     END SUB
  668. ' $SUBTITLE: 'ANSWERIT - subroutine to answer the phone when it rings'
  669. ' $PAGE
  670. '
  671. '  SUBROUTINE NAME    -- ANSWERIT
  672. '
  673. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  674. '                       SUBROUTINE.PARAMETER = 1   WAIT FOR PHONE TO RING
  675. '                       SUBROUTINE.PARAMETER = 2   CONTINUE LOOKING FOR CONNECT
  676. '                       SUBROUTINE.PARAMETER = 3   RENTRY AFTER FUNCTION KEY
  677. '                       SUBROUTINE.PARAMETER = 4   GO ON LINE IMMEDIATELY
  678. '                       BG                         LOCAL DISPLAY'S BACKGROUND
  679. '                       BORDER                     LOCAL DISPLAY'S BORDER COLOR
  680. '                       COM.PORT$                  COMMUNICATIONS PORT NAME
  681. '                       COMPUTER.TYPE              TYPE OF COMPUTER RUNNING ON
  682. '                       DUMB.MODEM                 NON-HAYES TYPE MODEM FLAG
  683. '                       EXTENDED.LOGGING           EXTENDED CALLERS LOG FLAG
  684. '                       FG                         LOCAL DISPLAY'S FOREGROUND
  685. '                       MODEM.ANSWER.COMMAND$      COMMAND TO ANSWER PHONE
  686. '                       MODEM.CONTROL.REGISTER     LOCATION OF MODEM CNTRL. REG
  687. '                       MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS
  688. '                       MODEM.INIT.BAUD$           BAUDE AT WHICH TO OPEN COMM.
  689. '                       MODEM.RESET.COMMAND$       COMMAND TO RESET THE MODEM
  690. '                       MODEM.STATUS.REGISTER      LOCATION OF MODEM STATUS REG
  691. '                       PRINTER                    FLAG TO PRINT ON LOCAL PRT.
  692. '                       REQUIRED.RINGS             NUMBER OF RINGS TO ANSWER ON
  693. '                       SNOOP                      FLAG TO DISPLAY ON LOCAL PC
  694. '                       SYSOP.NEXT                 FLAG TO GIVE SYSOP CONTROL
  695. '
  696. '  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  697. '                       EIGHT.BIT                  PARITY INDICATOR
  698. '                       RELIABLE.MODE              INDICATES MODEM-SUPPLIED
  699. '                                                  "ERROR-FREE" PROTOCOL ACTIVE
  700. '                       SUBROUTINE.PARAMETER = 1   CARRIER DETECT FOUND (I.E.
  701. '                                                  MODEM AUTO-ANSWERED).
  702. '                                            = 2   ANSWERED THE PHONE AND
  703. '                                                  CARRIER DETECT OCCURRED.
  704. '                                            = 3   SYSOP HIT "ESC" KEY ON THE
  705. '                                                  LOCAL KEYBOARD.
  706. '                                            = 4   ANSWERED THE PHONE BUT NO
  707. '                                                  CARRIER WAS DETECTED.
  708. '                                            = 5   COMM. BUFFER OVERFLOW.
  709. '                                            = 6   FUNCTION KEY PRESSED ON THE
  710. '                                                  LOCAL KEYBOARD.
  711. '
  712. '  SUBROUTINE PURPOSE -- TO ANSWER THE TELEPHONE WHEN IT RINGS.
  713. '
  714.       SUB ANSWERIT STATIC
  715.       EC = 0
  716.       RELIABLE.MODE = FALSE
  717.       FF = SUBROUTINE.PARAMETER
  718.       SUBROUTINE.PARAMETER = 0
  719.       ON FF GOTO 201,324,245,320
  720. '
  721. ' *
  722. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS          *
  723. ' *
  724. '
  725. 201 SUBROUTINE.PARAMETER = -10
  726.     CALL CARRIER
  727.     IF SUBROUTINE.PARAMETER = 0 THEN _
  728.        GOTO 210
  729.     EXIT.TO.DOORS = FALSE
  730.     PRIVATE.DOOR = FALSE
  731. '
  732. ' *
  733. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY    *
  734. ' *
  735. '
  736.     IF FOSSIL THEN _
  737.        STATE% = 0 : _
  738.        CALL FOSDTR(COMPORT%,STATE%) _
  739.     ELSE OUT MODEM.CONTROL.REGISTER,&H4
  740.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  741. '
  742. ' *
  743. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT   *
  744. ' *
  745. '
  746.     IF FOSSIL THEN _
  747.        STATE% = 1 : _
  748.        CALL FOSDTR(COMPORT%,STATE%) _
  749.     ELSE OUT MODEM.CONTROL.REGISTER,&H0
  750.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  751. 210 IF PRIVATE.DOOR THEN _
  752.        CALL TRANSFER : _
  753.        GOTO 235
  754.     CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  755. 220 SUBROUTINE.PARAMETER = 1
  756.     CALL AMORPM
  757. 230 IF PRINTER THEN _
  758.        CALL PRINTIT (" RBBS-PC " + VERSION.ID$ + " Node " + _
  759.                     NODE.ID$ + " up " + TIM$ + " on " + DATE$)
  760. 235 EIGHT.BIT = TRUE
  761.     SUBROUTINE.PARAMETER = -10
  762.     CALL CARRIER
  763.     IF SUBROUTINE.PARAMETER = 0 AND _
  764.        EXIT.TO.DOORS THEN _
  765.        CALL READPROF : _
  766.        SUBROUTINE.PARAMETER = 1 : _
  767.        GOTO 335
  768.     IF SUBROUTINE.PARAMETER = 0 AND _
  769.        EXPECT.ACTIVE.MODEM THEN _
  770.        BAUD.TEST = VAL(NETBAUD$) : _
  771.        CALL TESTREL (NETRELIABLE$) : _
  772.        GOTO 328
  773.     IF EXPECT.ACTIVE.MODEM OR _
  774.        EXIT.TO.DOORS THEN _
  775.        SUBROUTINE.PARAMETER = 4 : _
  776.        EXIT SUB
  777.     IF SUBROUTINE.PARAMETER = 0 THEN _
  778.        GOTO 324
  779.     PCJR = FALSE
  780.     IF COMPUTER.TYPE = 2 AND _
  781.        COM.PORT$ = "COM1" AND _
  782.        MODEM.STATUS.REGISTER = 1022 THEN _
  783.        MODEM.GO.OFFHOOK.COMMAND$ = CHR$(14) + _
  784.                                    "P" : _
  785.        PCJR = TRUE
  786.     CALL SYSMENU
  787.     IF PCJR THEN _
  788.        A$ = CHR$(14) + _
  789.             "I" _
  790.     ELSE A$ = MODEM.RESET.COMMAND$
  791.     CALL MODEMPUT (A$)
  792.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  793.     IF PCJR THEN _
  794.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  795.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  796.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  797.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  798.     ELSE A$ = MODEM.INIT.COMMAND$
  799.     CALL MODEMPUT (A$)
  800.     IF PCJR THEN _
  801.        A$ = CHR$(14) + _
  802.             "F 4" : _
  803.        CALL MODEMPUT (A$)
  804.     RINGBACK = FALSE
  805.     LOCATE 16,55
  806.     IF REQUIRED.RINGS = 0 THEN _
  807.        CALL LPRNT("WAITING FOR CARRIER",0) : _
  808.        GOTO 237
  809.     IF MID$(MODEM.INIT.COMMAND$, _
  810.           INSTR(MODEM.INIT.COMMAND$,"S0") + 3,3) = "255" THEN _
  811.        CALL LPRNT("RING BACK SYSTEM",0) : _
  812.        RINGBACK = TRUE : _
  813.        GOTO 236
  814.     CALL LPRNT("WAITING FOR RING ",0)
  815. 236 LOCATE 16,76 : _
  816.     CALL LPRNT(MID$(STR$(REQUIRED.RINGS),2),0)
  817. 237 LOCATE 18,76
  818.     IF DOSANSI THEN _
  819.        CALL LPRNT(ESCAPE$ + "[05m" + "YES" + ESCAPE$ + "[00m",0) _
  820.     ELSE CALL LPRNT ("YES",0)
  821.     COLOR FG,BG,BORDER
  822.     LOCATE 20,56
  823. '
  824. ' *
  825. ' *  GET READY TO ANSWER INCOMMING CALL:                                      *
  826. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.                        *
  827. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.            *
  828. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.                *
  829. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM INIT COMMAND.          *
  830. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER    *
  831. ' *           FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK).                 *
  832. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.          *
  833. ' *
  834. '
  835.     QQ = 255
  836.     I = INSTR(MODEM.INIT.COMMAND$,"S0")
  837.     IF I = 0 OR PCJR THEN _
  838.        GOTO 239
  839.     IF VAL(MID$(MODEM.INIT.COMMAND$,I + 3,3)) = 255 THEN _
  840.        QQ = 0 : _
  841.        BLK = QQ
  842.     CALL FINDTIME (TCA!)
  843.     SUBROUTINE.PARAMETER = 1
  844.     CALL LINE25
  845.     RING.ANSWER = TRUE
  846.     IF RINGBACK THEN _
  847.        RING.ANSWER = FALSE
  848. 239 RINGBACK.WAIT.STARTED! = 0
  849.     IF RINGBACK THEN _
  850.        CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _
  851.        COLOR 7,0,0 _
  852.     ELSE COLOR FG,BG,BORDER
  853. 240 IF SYSOP.NEXT THEN _
  854.        SUBROUTINE.PARAMETER = 3 : _
  855.        EXIT SUB
  856. '
  857. ' *
  858. ' * WAIT FOR INCOMING CALLS                                                   *
  859. ' *
  860. '
  861.     SCREEN.ALREADY.CLEARED = FALSE
  862. 245 CALL SETABORT (INACTIVE.DELAY!, (60 * RECYCLE.WAIT))
  863.     NO.CALL = TRUE
  864.     CALL FLUSHCOM (MODEM.RESPONSE$)
  865.     MODEM.RESPONSE$ = ""
  866.     WHILE INP(MODEM.STATUS.REGISTER) < 128 AND NO.CALL
  867.        CALL FINDFUNC
  868.        IF SUBROUTINE.PARAMETER < 0 THEN _
  869.           EXIT SUB
  870. 250    IF KEY.PRESSED$ = ESCAPE$ THEN _
  871.           SUBROUTINE.PARAMETER = 3 : _
  872.           EXIT SUB
  873. 260    IF RINGBACK.WAIT.STARTED! > 0 THEN _
  874.           CALL FINDTIME (TI!) : _
  875.        IF ABS(TI! - RINGBACK.WAIT.STARTED!) > 45 THEN _
  876.           RINGBACK.WAIT.STARTED! = 0 : _
  877.           RING.BACK.COUNT = 0 : _
  878.           RING.ANSWER = FALSE: _
  879.           IF RINGBACK THEN _
  880.             LOCATE 20,56 : _
  881.             CALL LPRNT("Ringback timeout" + PAGING.PRINTER.SUPPORT$,1)
  882. 265    CALL FINDTIME (TI!)
  883.        IF ABS(TI! - TCA!) > 120 AND NOT SCREEN.ALREADY.CLEARED THEN _
  884.           LOCATE ,,0 : _
  885.           CLS : _
  886.           C.L = 1 : _
  887.           SCREEN.ALREADY.CLEARED = TRUE : _
  888.           CALL FINDTIME (TCA!)
  889.        IF TIME.TO.DROP.TO.DOS! > 0 AND _
  890.           OLD.DAT$ <> DATE$ AND _
  891.           TI! < 86340 AND _        ' Skip btw 23:59 and 00:00
  892.           TI! => TIME.TO.DROP.TO.DOS! THEN _
  893.              SUBROUTINE.PARAMETER = 7 : _
  894.              EXIT SUB
  895. 266    IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
  896.           REQUIRED.RINGS > 0 THEN _
  897.           GOTO 276
  898. 270    IF RECYCLE.WAIT > 0 THEN _
  899.           IF TI! > INACTIVE.DELAY! THEN _
  900.              SUBROUTINE.PARAMETER = 8 : _
  901.              EXIT SUB
  902.        CALL FLUSHCOM (X$)
  903.        IF LEN(X$) > 0 THEN _
  904.           MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$ : _
  905.           RING.DETECTED = (INSTR(MODEM.RESPONSE$,"RING") > 0) : _
  906.           CONNECT.DETECTED = (INSTR(MODEM.RESPONSE$,"ONNECT") > 0) : _
  907.           NO.CALL = (NOT RING.DETECTED) AND (NOT CONNECT.DETECTED)
  908.     IF RING.DETECTED AND REQUIRED.RINGS > 0 THEN _
  909.        MID$(MODEM.RESPONSE$, INSTR(MODEM.RESPONSE$,"RING")+1,1) = "A" : _
  910.        RING.DETECTED = FALSE : _
  911.        GOTO 276
  912.     CALL GOIDLE
  913.     WEND
  914.     IF NOT RINGBACK THEN _
  915.        IF CONNECT.DETECTED THEN _
  916.           GOTO 321
  917.     IF REQUIRED.RINGS = 0 THEN _
  918.        CALL DELAYIT (3) : _
  919.        GOTO 321
  920. '
  921. ' *
  922. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR  *
  923. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --     *
  924. ' * "RING BACK."                                                              *
  925. ' *
  926. '
  927. 276 CALL EOFCOMM (CHAR%)
  928.     IF CHAR% <> -1 THEN _
  929.        CALL FLUSHCOM(X$) : _
  930.        IF SUBROUTINE.PARAMETER = - 1 THEN _
  931.           EXIT SUB
  932.     IF PCJR THEN _
  933.        GOTO 320
  934.     A$ = MODEM.COUNT.RINGS.COMMAND$
  935.     CALL MODEMPUT (A$)
  936.     CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  937. 290 CALL FLUSHCOM(X$)
  938.     IF SUBROUTINE.PARAMETER = -1 THEN _
  939.        EXIT SUB
  940. 291 IF LEN(X$) = 0 THEN _
  941.        GOTO 310
  942. 292 IF INSTR(X$,"0") < 1 THEN _
  943.        GOTO 293
  944.     X$ = MID$(X$,INSTR(X$,"0"))
  945. 293 IF (NOT RING.ANSWER) AND (VAL(X$) < RING.BACK.COUNT) THEN _
  946.        RING.ANSWER = TRUE
  947. 300 RING.BACK.COUNT = VAL(X$)
  948.     Q = RING.BACK.COUNT + 1
  949.     IF (NOT RING.ANSWER) THEN _
  950.        Q = 0
  951. 305 LOCATE 20,56
  952.     CALL LPRNT(TIME$ + " Ring " + STR$(Q),0)
  953. 310 IF (RING.BACK.COUNT + 1 < REQUIRED.RINGS) OR _
  954.        (NOT RING.ANSWER) THEN _
  955.        GOTO 239
  956. 320 IF PCJR THEN _
  957.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  958.             "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  959.             "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  960.     ELSE A$ = MODEM.ANSWER.COMMAND$
  961.     CALL MODEMPUT (A$)
  962. '
  963. ' *
  964. ' *  TEST FOR CARRIER PRESENT                                                 *
  965. ' *
  966. '
  967. 321 CALL SETABORT (CONNECT.DELAY!,MAX.CARRIER.WAIT)
  968.     IF CONNECT.DELAY! > 86399 THEN _
  969.        CONNECT.DELAY! = 86399
  970. 322 CALL FINDTIME (TI!)
  971. 323 SUBROUTINE.PARAMETER = -10
  972.     CALL CARRIER
  973.     IF SUBROUTINE.PARAMETER AND _
  974.        TI! < CONNECT.DELAY! THEN _
  975.        GOTO 322
  976.     IF SUBROUTINE.PARAMETER THEN _
  977.        SUBROUTINE.PARAMETER = 4 : _
  978.        EXIT SUB
  979.     CALL DELAYIT (3)
  980. 324 SUBROUTINE.PARAMETER = 0
  981.     IF TI! > CONNECT.DELAY! THEN _
  982.        CALL UPDTCALR ("Connect timeout",1) : _
  983.        SUBROUTINE.PARAMETER = 4 : _
  984.        EXIT SUB
  985. 325 CALL FLUSHCOM(X$)
  986.     IF SUBROUTINE.PARAMETER = -1 THEN _
  987.        IF EC = 69 THEN _
  988.           SUBROUTINE.PARAMETER = 5 : _
  989.        EXIT SUB
  990.     MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$
  991.     CALL FINDTIME (TI!)
  992.     IF TI! > CONNECT.DELAY! THEN _
  993.        CALL UPDTCALR ("Connect timeout",1) : _
  994.        SUBROUTINE.PARAMETER = 4 : _
  995.        EXIT SUB
  996.     IF DUMB.MODEM THEN _
  997.        BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _
  998.        GOTO 327
  999.     IF INSTR(MODEM.RESPONSE$,"FAST") THEN _
  1000.        BAUD.TEST = 19200 : _
  1001.        GOTO 327
  1002.     IF INSTR(MODEM.RESPONSE$,"ONNECT") THEN _
  1003.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONNECT") + 7)) : _
  1004.        GOTO 327
  1005.     IF INSTR(MODEM.RESPONSE$,"ONLINE") THEN _
  1006.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONLINE") + 7)) : _
  1007.        GOTO 327
  1008.     GOTO 324
  1009. 327 CALL TESTREL (MODEM.RESPONSE$)
  1010. 328 IF BAUD.TEST = 0 OR BAUD.TEST = 300 THEN _
  1011.        BAUD.TEST = 300 : _
  1012.        BPS = -1 : _
  1013.        GOTO 331
  1014.     IF BAUD.TEST = 1200 OR BAUD.TEST = 1275 THEN _
  1015.        BPS = -3 : _
  1016.        GOTO 331
  1017.     IF BAUD.TEST = 2400 THEN _
  1018.        BPS = -4 : _
  1019.        GOTO 331
  1020.     IF BAUD.TEST = 4800 OR BAUD.TEST = 9600 THEN _
  1021.        BPS = -4-(BAUD.TEST /4800) : _
  1022.        GOTO 331
  1023.     IF BAUD.TEST = 19200 THEN _
  1024.        BPS = -7 : _
  1025.        GOTO 331
  1026.     GOTO 324
  1027. 331 CALL SETBAUD
  1028.     SUBROUTINE.PARAMETER = 2
  1029. 335 DONT.WRITE = 0
  1030.     END SUB
  1031. ' $SUBTITLE: 'TESTREL - Test for Reliable mode connection'
  1032. ' $PAGE
  1033. '
  1034. '  SUBROUTINE NAME    -- TESTREL
  1035. '
  1036. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1037. '                           STRNG$                 String to check for reliable
  1038. '
  1039. '  OUTPUT PARAMETERS  --    RELIABLE.MODE          Reliable mode indicator
  1040. '
  1041. '  SUBROUTINE PURPOSE -- TO TEST FOR RELIABLE CONNECT
  1042. '
  1043. 336 SUB TESTREL (STRNG$) STATIC
  1044.     RELIABLE.MODE = FALSE
  1045.     IF STRNG$ = "" THEN _
  1046.        EXIT SUB
  1047.     IF INSTR(STRNG$,"REL") OR _
  1048.        INSTR(STRNG$,"R C") OR _       (ERROR CONTROL)
  1049.        INSTR(STRNG$,"ARQ") OR _
  1050.        INSTR(STRNG$,"LAP") OR _
  1051.        INSTR(STRNG$,"AFT") OR _
  1052.        INSTR(STRNG$,"MNP") THEN _
  1053.          RELIABLE.MODE = -1
  1054.     END SUB
  1055. ' $SUBTITLE: 'BADCHAR - subroutine to check user names for bad characters'
  1056. ' $PAGE
  1057. '
  1058. '  SUBROUTINE NAME    -- BADCHAR
  1059. '
  1060. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1061. '                           PASSED.NAME$           USER NAME
  1062. '
  1063. '  OUTPUT PARAMETERS  --    PASSED.NAME$           USER NAME WILL CONTAIN ""
  1064. '                                                  IF BAD CHARACTERS FOUND
  1065. '
  1066. '  SUBROUTINE PURPOSE -- TO CHECK USER NAMES FOR INVALID CHARACTERS
  1067. '
  1068.     SUB BADCHAR (PASSED.NAME$) STATIC
  1069.     J = 1
  1070.     XX = LEN(PASSED.NAME$)
  1071. 457 IF J > XX THEN _
  1072.        EXIT SUB
  1073.     X$ = MID$(PASSED.NAME$,J,1)
  1074.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",X$) = 0 THEN _
  1075.        PASSED.NAME$ = "" : _
  1076.        EXIT SUB
  1077.     J = J + 1
  1078.     GOTO 457
  1079.     END SUB
  1080. ' $SUBTITLE: 'PASSWRD - verify User and Message passwords'
  1081. ' $PAGE
  1082. '
  1083. '  SUBROUTINE NAME    -- PASSWRD
  1084. '
  1085. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1086. '                        SUBROUTINE.PARAMETER = 1  VERIFY USER PASSWORD
  1087. '                        SUBROUTINE.PARAMETER = 2  VERIFY MESSAGE PASSWORD
  1088. '                        SUBROUTINE.PARAMETER = 3  VERIFY MESSAGE PASSWORD
  1089. '                        SUBROUTINE.PARAMETER = 4  VERIFY MESSAGE PASSWORD
  1090. '                        SUBROUTINE.PARAMETER = 5  VERIFY MESSAGE PASSWORD
  1091. '
  1092. '  OUTPUT PARAMETERS  -- PASSWORD.FAILED           SET TO 0 IF PASSED
  1093. '                                                  SET TO -1 IF FAILED
  1094. '
  1095. '  SUBROUTINE PURPOSE -- TO VERIFY USER AND MESSAGE PASSWORDS
  1096. '
  1097.     SUB PASSWRD STATIC
  1098.     EC = 0
  1099.     ON SUBROUTINE.PARAMETER GOTO 665,667,670,675,677
  1100. 665 IF PASSWORD.SAVE$ = PASSWORD$ THEN _
  1101.        PASSWORD.FAILED = 0 : _
  1102.        EXIT SUB
  1103. 667 ATTEMPTS = 0
  1104. 670 ATTEMPTS = ATTEMPTS + 1
  1105.     IF ATTEMPTS > ATTEMPTS.ALLOWED THEN _
  1106.        PASSWORD.FAILED = TRUE : _
  1107.        EXIT SUB
  1108. 675 A$ = "Enter Password (dots echo)"
  1109.     HIDDEN = TRUE
  1110.     SUBROUTINE.PARAMETER = 1
  1111.     CALL TGET
  1112.     IF SUBROUTINE.PARAMETER < 0 THEN _                               ' KG122504
  1113.        PASSWORD.FAILED = TRUE : _                                    ' KG122504
  1114.        EXIT SUB                                                      ' KG122504
  1115.     HIDDEN = FALSE
  1116.     Z$ = B$
  1117. 677 IF LEN(Z$) > 15 THEN _
  1118.        GOTO 680
  1119.     IF EC <> 0 THEN _
  1120.        GOTO 670
  1121.     CALL ALLCAPS (Z$)
  1122.     Z$ = Z$ + SPACE$(15 - LEN(Z$))
  1123.     IF PASSWORD.SAVE$ = Z$ THEN _
  1124.        PASSWORD.FAILED = 0 : _
  1125.        A$ = "" : _                        'PE 11/11/88
  1126.        EXIT SUB
  1127. 680 CALL QTPUT("Wrong password ",1)
  1128.     IF NOT MESSAGE.PASSWORD THEN _
  1129.        CALL UPDTCALR (ACTIVE.USER.NAME$+" PW fail: " + Z$,1)
  1130.     GOTO 670
  1131.     END SUB
  1132. ' $SUBTITLE: 'LINE25 - subroutine to build/display RBBS-PCs line 25'
  1133. ' $PAGE
  1134. '
  1135. '  SUBROUTINE NAME    -- LINE25
  1136. '
  1137. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1138. '                        SUBROUTINE.PARAMETER = 1  BUILD DISPLAY FOR LINE 25
  1139. '                        SUBROUTINE.PARAMETER = 2  UPDATE LINE 25
  1140. '                        LOCK.STATUS$              STATUS OF LOCKS IN A MULTI-
  1141. '                                                  USER ENVIRONMENT OR TIME OF
  1142. '                                                  DAY USER LOGGED ON OR THE
  1143. '                                                  RE-CYCLED
  1144. '
  1145. '  OUTPUT PARAMETERS  -- CURSOR.LINE               CURRENT LINE ON SCREEN
  1146. '                        CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  1147. '
  1148. '  SUBROUTINE PURPOSE -- TO BUILD OR UPDATE RBBS-PC'S LINE 25 DISPLAYED
  1149. '                        ON THE PC SCREEN THAT IS RUNNING RBBS-PC.
  1150. '
  1151.       SUB LINE25 STATIC
  1152.       IF SUBROUTINE.PARAMETER = 2 THEN _
  1153.          GOTO 950
  1154. '
  1155. ' *
  1156. ' *  BUILD LINE 25 DISPLAY                                                    *
  1157. ' *
  1158. '
  1159. 949 LINE.25$ = "Node " + _
  1160.                NODE.ID$ + " " + _
  1161.                PAGE.STATUS$ + " " + _
  1162.                MID$("    AVL ",1 - 4 * SYSOP.AVAILABLE,4) + _
  1163.                MID$("    ANY ",1 - 4 * SYSOP.ANNOY,4) + _
  1164.                MID$("    LPT ",1 - 4 * PRINTER,4) + _
  1165.                MID$("SYS",1,-3 * SYSOP.NEXT) + _
  1166.                MID$(" XOFF",1,-5 * XOFF.ED) + _
  1167.                MID$(" CTS",1,-4 * NOT.CTS)
  1168. '
  1169. ' *
  1170. ' *  LINE 25 UPDATE ROUTINE                                                   *
  1171. ' *
  1172. '
  1173. 950 IF NOT SNOOP THEN _
  1174.        EXIT SUB
  1175.     CURSOR.LINE = CSRLIN
  1176.     CURSOR.ROW = POS(0)
  1177.     HH = LEN(ACTIVE.USER.NAME$) + _
  1178.          LEN(CI$) + _
  1179.          LEN(LINE.25$) + _
  1180.          LEN(STR$(USER.SECURITY.LEVEL)) + _
  1181.          18
  1182. '    IF AUTODOWNLOAD.AVAILABLE THEN _
  1183. '       HH = HH + 4
  1184.     LOCATE 25,1
  1185.     IF NETWORK.TYPE = 0 THEN _
  1186.       LOCK.STATUS$ = SPACE$(3) + _
  1187.                            TIME.LOGGED.ON$
  1188.     IF HH > 79 THEN _
  1189.        HH = 78
  1190.     LINE.25.HOLD$ = LINE.25$ + _
  1191.                     SPACE$(79 - HH) + _
  1192.                     STR$(USER.SECURITY.LEVEL) + _
  1193.                     " " + _
  1194.                     ACTIVE.USER.NAME$ + _
  1195.                     " " + _
  1196.                     CI$ + _
  1197.                     " " + _
  1198.                     LOCK.STATUS$
  1199.     CALL LPRNT(LINE.25.HOLD$,0)
  1200.     LOCATE CURSOR.LINE,CURSOR.ROW
  1201.     END SUB
  1202. ' $SUBTITLE: 'SRCHCMND    - subroutine to search command list'
  1203. ' $PAGE
  1204. '
  1205. '  SUBROUTINE NAME    -- SRCHCMND
  1206. '
  1207. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1208. '                        STRT.POS      POSITION TO BEGIN SEARCH AT
  1209. '                        ALL.OPTS$     STRING TO SEARCH (COMMAND LIST)
  1210. '                        Z$            WHAT TO LOOK FOR
  1211. '
  1212. '  OUTPUT PARAMETERS  -- WHERE.FOUND   POSITION OF Z$ IN ALL.OPTS$
  1213. '                                      0 IF NOT FOUND
  1214. '
  1215. '  SUBROUTINE PURPOSE -- SEARCHES VALID COMMAND LIST FOR THE REQUESTED
  1216. '                        COMMAND.  IF THE SYSOP HAS CONFIGURED RBBS-PC TO
  1217. '                        RESTRICT COMMANDS TO ONLY THOSE VALID WITHIN THE
  1218. '                        RBBS-PC SUBSYSTEM, THEN ONLY THOSE COMMANDS AND
  1219. '                        "GLOBAL" COMMANDS ARE VALID.  OTHERWISE ALL COMMANDS
  1220. '                        ARE VALID FROM ANY OF THE RBBS-PC SUBSYSTEMS.
  1221. '
  1222.      SUB SRCHCMND (STRT.POS,WHERE.FOUND) STATIC
  1223. 1240 IF LEN(Z$) < 1 THEN _
  1224.         WHERE.FOUND = 0 : _
  1225.         EXIT SUB
  1226.      CALL ALLCAPS (Z$)          'KG111104
  1227.      Y$ = LEFT$(Z$,1)
  1228.      WHERE.FOUND = INSTR(STRT.POS,ALL.OPTS$,Y$)
  1229.      IF WHERE.FOUND = 0 THEN _  'Not found: decide whether to hunt further
  1230.         IF STRT.POS < 2 OR RESTRICT.VALID.CMDS THEN _
  1231.            GOTO 1242 _  ' fully searched or restricted
  1232.         ELSE WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _ 'hunt further
  1233.              GOTO 1242
  1234.      IF WHERE.FOUND => BEG.LIBRARY THEN _
  1235.         IF WHERE.FOUND < LEN(ALL.OPTS$) - 11 THEN _
  1236.            IF LIBRARY.TYPE = 0 THEN _
  1237.               WHERE.FOUND = INSTR(WHERE.FOUND+1,ALL.OPT$,Y$) : _
  1238.               IF WHERE.FOUND = 0 THEN _
  1239.                  WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _
  1240.                  IF WHERE.FOUND >= BEG.LIBRARY OR WHERE.FOUND = 0 THEN _
  1241.                     WHERE.FOUND = 0 : _
  1242.                     GOTO 1242
  1243.      IF NOT RESTRICT.VALID.CMDS THEN _
  1244.         GOTO 1242            ' everything found valid
  1245. '
  1246. ' *
  1247. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)                 *
  1248. ' *
  1249. '
  1250.      IF WHERE.FOUND > LEN(ALL.OPTS$) - 11 THEN _
  1251.         IF USER.SECURITY.LEVEL < OPT.SEC(WHERE.FOUND) THEN _
  1252.            WHERE.FOUND = 0 : _
  1253.            EXIT SUB _
  1254.         ELSE EXIT SUB
  1255.      IF MID$(ORIG.COMMANDS$,WHERE.FOUND,1) = "G" THEN _
  1256.         EXIT SUB                          ' ACCEPT GOODBYE/GRAPHICS
  1257.      IF (WHERE.FOUND < STRT.POS) OR _
  1258.         (STRT.POS < BEG.FILE AND WHERE.FOUND => BEG.FILE ) OR _
  1259.         (STRT.POS < BEG.UTIL AND WHERE.FOUND => BEG.UTIL ) OR _
  1260.         (STRT.POS < BEG.LIBRARY AND WHERE.FOUND => BEG.LIBRARY ) THEN _
  1261.           WHERE.FOUND = 0                 ' REJECT: NOT IN SECTION
  1262. 1242 IF WHERE.FOUND > 0 AND LEN(Z$) = 1 THEN _
  1263.         EXIT SUB
  1264.      CALL CHKMACRO (Z$,FOUND)
  1265.      IF FOUND THEN _
  1266.         GOTO 1240
  1267.      END SUB
  1268. ' $SUBTITLE: 'CHKMACRO    - subroutine to check if macro exits and process'
  1269. ' $PAGE
  1270. '
  1271. '  SUBROUTINE NAME    -- CHKMACRO
  1272. '
  1273. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1274. '                      STRNG$           STRING TO CHECK IF IS A MACRO
  1275. '                      MACRO.DRVPATH$   DRIVE/PATH WHERE MACROS ARE
  1276. '                      MACRO.EXTENSION$ EXTENSION OF MACROS
  1277. '
  1278. '  OUTPUT PARAMETERS - MACRO.FOUND      WHETHER A MACRO WAS FOUND
  1279. '                      STRNG$           SUBSTITUTE FOR COMMANDS
  1280. '                      COMMPORT.STACK$  REST OF MACRO
  1281. '                                      0 IF NOT FOUND
  1282. '
  1283. '  SUBROUTINE PURPOSE -- MACRO FILE IS CHECKED FOR SECURITY (1ST LINE).
  1284. '                        2ND LINE IS SUBSTITUTED FOR PASSED STRING
  1285. '                        AND PARSED.  REMAINING PART OF MACRO PUT INTO
  1286. '                        STACK TO BE EXECUTED.
  1287. '
  1288.      SUB CHKMACRO (STRNG$,MACRO.FOUND) STATIC
  1289.      MACRO.FOUND = FALSE
  1290.      FILNAME$ = MACRO.DRVPATH$ + STRNG$ + MACRO.EXTENSION$
  1291.      CALL BADFILE (FILNAME$,A)
  1292.      IF A > 1 THEN _
  1293.         EXIT SUB
  1294.      CALL FINDIT (FILNAME$)
  1295.      IF NOT OK THEN _
  1296.         EXIT SUB
  1297.      CALL READDIR (1)
  1298.      IF EC > 0 THEN _
  1299.         EXIT SUB
  1300.      CALL CHECKINT (A$)
  1301.      IF EC > 0 OR USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _
  1302.         EXIT SUB
  1303.      CALL READDIR (1)
  1304.      IF EC > 0 THEN _
  1305.         EXIT SUB
  1306.      MACRO.FOUND = TRUE
  1307.      STRNG$ = A$
  1308.      B$ = STRNG$
  1309.      CALL PARSEIT
  1310.      Y$ = ""
  1311.      WHILE NOT EOF(2)
  1312.         CALL READDIR (1)
  1313.         Y$ = Y$ + A$ + CARRIAGE.RETURN$
  1314.      WEND
  1315.      COMMPORT.STACK$ = COMMPORT.STACK$ + Y$
  1316.      END SUB
  1317. ' $SUBTITLE: 'VIEWHELP    - Processes requests for help'
  1318. ' $PAGE
  1319. '
  1320. '  SUBROUTINE NAME    -- VIEWHELP
  1321. '
  1322. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1323. '                       SECTION             ORDER OF 1ST COMMAND IN CURRENT
  1324. '                                              SECTION
  1325. '                       GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1326. '                       HELP.DEFAULT$       HELP GET IF PRESS ENTER
  1327. '                       HELP.PATH$
  1328. '                       HELP.EXTENSION$
  1329. '                       BEG.FILE
  1330. '                       BEG.MAIN
  1331. '                       BEG.UTIL
  1332. '                       BEG.LIBRARY
  1333. '
  1334. '  OUTPUT PARAMETERS  -- DISPLAYS HELP
  1335. '
  1336. '  SUBROUTINE PURPOSE -- THE MAIN HELP PROCESSOR FOR RBBS.  PUTS UP THE
  1337. '                        OPTIONAL MENU.  ACCEPTS HELP WITH INDIVIDUAL
  1338.      SUB VIEWHELP (SECTION,GRAPHIC.DEFAULT$,HELP.DEFAULT$) STATIC
  1339. 1330 HELP.MENU$ = HELP.PATH$ + _
  1340.                   "HELP" + _
  1341.                   HELP.EXTENSION$
  1342.      GOT.MENU = TRUE
  1343.      IF Q > 1 THEN _
  1344.         ANS.INDEX = 2 : _
  1345.         LAST.INDEX = Q: _
  1346.         FAST.HELP = TRUE : _
  1347.         GOTO 1332
  1348. 1331 IF GOT.MENU THEN _
  1349.         FILE.NAME$ = HELP.MENU$ : _
  1350.         GOSUB 1350 : _
  1351.         GOT.MENU = FALSE
  1352.      ANS.INDEX = 1
  1353.      A$ = "Help with what Command (or TOPIC name)" + _
  1354.           PRESS.ENTER.EXPERT$
  1355.      SUBROUTINE.PARAMETER = 1
  1356.      CALL TGET
  1357.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1358.         EXIT SUB
  1359.      IF Q = 0 THEN _
  1360.         EXIT SUB
  1361.      LAST.INDEX = Q
  1362. 1332 Z$ = B$(ANS.INDEX)
  1363.      CALL ALLCAPS (Z$)
  1364.      IF Z$ = "?" THEN _
  1365.         Z$ = "H"
  1366.      CALL BADFILE (Z$,BAD.FILE.NAME.INDEX)
  1367.      ON BAD.FILE.NAME.INDEX GOTO 1333,1340,1340
  1368. 1333 IF LEN(Z$) = 1 THEN _
  1369.         CALL SRCHCMND (SECTION,FF) : _
  1370.         IF FF < 1 THEN _
  1371.            OK = FALSE : _
  1372.            GOTO 1334 _
  1373.         ELSE X = - (FF => BEG.MAIN) - (FF => BEG.FILE) - (FF => BEG.UTIL) - (FF => BEG.LIBRARY) : _
  1374.              Z$ = MID$("MFU@",X,1) + _
  1375.                   MID$(ORIG.COMMANDS$,FF,1)
  1376.      FILE.NAME$ = HELP.PATH$ + _
  1377.                   Z$ + _
  1378.                   HELP.EXTENSION$
  1379.      GOSUB 1350
  1380. 1334 IF NOT OK THEN _
  1381.         A$ = "No help for " + _
  1382.              Z$ : _
  1383.         CALL QTPUT (A$,1) : _
  1384.         CALL UPDTCALR (A$,2)
  1385.      ANS.INDEX = ANS.INDEX + 1
  1386.      IF ANS.INDEX <= LAST.INDEX THEN _
  1387.         GOTO 1332
  1388.      IF FAST.HELP THEN _
  1389.         FAST.HELP = FALSE : _
  1390.         EXIT SUB
  1391.      GOTO 1331
  1392. 1340 OK = FALSE
  1393.      GOTO 1334
  1394. 1350 CALL GRAPHIC (GRAPHIC.DEFAULT$)
  1395.      CALL BUFFILE (FILE.NAME$,X)
  1396.      RETURN
  1397.      END SUB
  1398. ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1399. ' $PAGE
  1400. '
  1401. '  SUBROUTINE NAME    -- SVIOLATION
  1402. '
  1403. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1404. '
  1405. '  OUTPUT PARAMETERS  -- CURSOR.LINE               CURRENT LINE ON SCREEN
  1406. '                        CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  1407. '
  1408. '  SUBROUTINE PURPOSE -- INFORM CALLER OF SECURITY VIOLATION, AUGMENT COUNT OF
  1409. '                        VIOLATIONS AND DETERMINE WHETHER TOO MANY OCCURRED.
  1410. '
  1411. 1380 SUB SVIOLATION STATIC
  1412.      CALL BUFFILE (SECVIO.HLP$,X)
  1413.      IF NOT OK THEN _
  1414.         CALL QTPUT ("Sorry, " + FIRST.NAME$ + ", Security is to low for this feature",1)
  1415.      CALL UPDTCALR ("SV!-" + VIOLATION$,2)
  1416.      VIOLATIONS.THIS.SESSION = VIOLATIONS.THIS.SESSION + 1
  1417.      IF MAXIMUM.VIOLATIONS = 0 OR VIOLATIONS.THIS.SESSION <= MAXIMUM.VIOLATIONS THEN _
  1418.         EXIT SUB
  1419. 1385 IF USER.FILE.INDEX < 1 THEN _
  1420.         EXIT SUB
  1421.      A$ = "TO MANY SECURITY VIOLATIONS!  Sysop can reinstate"
  1422.      IF USER.SECURITY.LEVEL <= MINIMUM.LOGON.SECURITY THEN _
  1423.         A$ = "" : _
  1424.         USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - 1 _
  1425.      ELSE USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY
  1426.      DENY.ACCESS = TRUE
  1427.      END SUB
  1428. ' $SUBTITLE: 'DENYACCESS - subroutine to build/display RBBS-PCs line 25'
  1429. ' $PAGE
  1430. '
  1431. '  SUBROUTINE NAME    -- DENYACCESS
  1432. '
  1433. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1434. '
  1435. '  OUTPUT PARAMETERS  -- (USER'S RECORD)
  1436. '
  1437. '  SUBROUTINE PURPOSE -- PERMANENTLY RESETS USER'S SECURITY LEVEL
  1438. '                        WHEN DENIED ACCESS
  1439. '
  1440.      SUB DENYACCESS STATIC
  1441. 1386 CALL TPUT
  1442.      LOGON.ERROR.INDEX = 5
  1443.      SUBROUTINE.PARAMETER = 6
  1444.      CALL FILELOCK
  1445.      CALL OPENUSER (HIGHEST.USER.RECORD)
  1446.      FIELD 5, 128 AS USER.RECORD$
  1447.      GET 5,USER.FILE.INDEX
  1448.      MID$(USER.RECORD$,47,2) = MKI$(USER.SECURITY.LEVEL)
  1449.      PUT 5,USER.FILE.INDEX
  1450.      SUBROUTINE.PARAMETER = 8
  1451.      CALL FILELOCK
  1452.      END SUB
  1453. ' $SUBTITLE: 'TPUT -- RBBS-PC common routine to write to comm. port'
  1454. ' $PAGE
  1455. '
  1456. '  SUBROUTINE NAME    -- TPUT (TERMINAL PUT)
  1457. '
  1458. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1459. '                                A$                 STRING TO WRITE TO THE
  1460. '                                                   COMMUNICATIONS PORT
  1461. '                         SUBROUTINE.PARAMETER = 1  SKIP A LINE BEFORE WRITING
  1462. '                                                   TO THE COMMUNICATIONS PORT
  1463. '                         SUBROUTINE.PARAMETER = 2  SKIP A LINE BEFORE WRITING
  1464. '                                                   TO THE COMMUNICATIONS PORT
  1465. '                                                   AND THEN SKIP TWO LINES
  1466. '                                                   AFTER WRITING TO THE COMM-
  1467. '                                                   UNICATIONS PORT
  1468. '                         SUBROUTINE.PARAMETER = 3  WRITE TO THE COMMUNICATIONS
  1469. '                                                   PORT AND THEN SKIP TWO
  1470. '                                                   LINES
  1471. '                         SUBROUTINE.PARAMETER = 4  WRITE TO THE COMMUNICATIONS
  1472. '                                                   PORT WITHOUT A CR/LF
  1473. '                         SUBROUTINE.PARAMETER = 5  WRITE TO THE COMMUNICATIONS
  1474. '                                                   PORT WITH A CR/LF
  1475. '                         SUBROUTINE.PARAMETER = 6  RESET EVERYTHING FOR INPUT
  1476. '                                                   STRING
  1477. '                         SUBROUTINE.PARAMETER = 7  RE-ENTRY AFTER HANDLING A
  1478. '                                                   FUNCTION KEY
  1479. '
  1480. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  1481. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  1482. '
  1483. '  SUBROUTINE PURPOSE --  COMMON OUTPUT ROUTINE FOR RBBS-PC TO THE
  1484. '                         COMMUNICATIONS PORT (TERMINAL PUT)
  1485.       SUB TPUT STATIC
  1486.       IF SUBROUTINE.PARAMETER <> 7 THEN _
  1487.          PARM = SUBROUTINE.PARAMETER
  1488.       ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411
  1489. '
  1490. ' *
  1491. ' *  COMMON OUTPUT ROUTINE                                                    *
  1492. ' *
  1493. '
  1494. 1398 CALL SKIPLINE (1)
  1495.      GOTO 1405
  1496. 1399 CALL SKIPLINE (1)
  1497. 1400 CR = 1
  1498. 1403 CR = CR + 1
  1499. 1405 RET = FALSE
  1500.      IF CM THEN _
  1501.         GOTO 1435
  1502. 1410 CALL FINDFUNC
  1503.      IF SUBROUTINE.PARAMETER < 0 THEN _
  1504.         EXIT SUB
  1505. 1411 Y$ = KEY.PRESSED$
  1506.      SUBROUTINE.PARAMETER = PARM
  1507.      IF LOCAL.USER THEN _
  1508.         GOTO 1430
  1509.      CALL EOFCOMM (CHAR%)
  1510.      IF CHAR% = -1 THEN _
  1511.         CALL CARRIER : _
  1512.         IF SUBROUTINE.PARAMETER = -1 THEN _
  1513.            EXIT SUB _
  1514.         ELSE GOTO 1430
  1515.      CALL GETCOM(Y$)
  1516. 1425 IF SUBROUTINE.PARAMETER = -1 THEN _
  1517.         EXIT SUB
  1518. 1430 IF Y$ = "" THEN _
  1519.         GOTO 1435
  1520.      ON INSTR(INTERRUPT.ON$,Y$) GOTO 1434,1434,1473,1475,1433
  1521.      GOSUB 1476
  1522.      GOTO 1435
  1523. 1433 GOSUB 1476
  1524.      IF ASC(RIGHT$(COMMPORT.STACK$,2)) = 13 OR _
  1525.         STOP.INTERRUPTS THEN _
  1526.         GOTO 1435  'stack if series of [ENTER]s or no previous stack
  1527.      GOTO 1471
  1528. 1434 IF STOP.INTERRUPTS THEN _
  1529.         GOTO 1435
  1530.      COMMPORT.STACK$ = ""
  1531.      IF FOSSIL THEN _
  1532.         CALL FOSTXPURGE(COMPORT%) : _
  1533.         CALL FOSRXPURGE(COMPORT%)
  1534.      GOTO 1471
  1535. 1435 LOCATE ,,1
  1536.      CALL LPRNT (A$,0)             'KG122404
  1537. 1437 IF UPPER.CASE THEN _
  1538.         IF GR <> 2 THEN _
  1539.            CALL ALLCAPS (A$)
  1540.      CALL PUTCOM (A$)
  1541. 1450 IF CR <> 1 THEN _
  1542.         CALL SKIPLINE (1) _
  1543.      ELSE IF CR > 1 THEN _
  1544.              CALL SKIPLINE (1)
  1545. 1470 CR = 0
  1546.      TOA! = FRE("A")
  1547.      EXIT SUB
  1548. 1471 CALL SKIPLINE (1)
  1549.      STOP.INTERRUPTS = FALSE
  1550.      RET = TRUE
  1551.      NON.STOP = FALSE
  1552.      GOTO 1470
  1553. 1473 XOFF.ED = TRUE
  1554.      GOTO 1410
  1555. 1475 XOFF.ED = FALSE
  1556.      GOTO 1410
  1557. 1476 IF ASC(Y$) < 127 THEN _
  1558.         COMMPORT.STACK$ = COMMPORT.STACK$ + Y$
  1559.      RETURN
  1560.      END SUB
  1561. ' $SUBTITLE: 'QTPUT    - subroutine to quickly write to terminal'
  1562. ' $PAGE
  1563. '
  1564. '  SUBROUTINE NAME    -- QTPUT
  1565. '
  1566. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1567. '                        STRNG$        STRING TO WRITE OUT
  1568. '                        NUM.RETURNS   NUMBER OF CARRIAGE RETURNS
  1569. '
  1570. '  OUTPUT PARAMETERS  -- NONE
  1571. '
  1572. '  SUBROUTINE PURPOSE -- SUBROUTINE TO QUICKLY WRITE TO THE TERMINAL.  THIS IS
  1573. '                        IS DIFFERENT FROM "TPUT" IN THE THINGS IT DOESN'T DO:
  1574. '                                A.) NO FUNCTION KEY CHECK,
  1575. '                                B.) NO CONVERSION TO UPPER CASE,
  1576. '                                C.) NO STRING RE-INITILIZATION OF "STRNG$",
  1577. '                                D.) NO CHECK FOR CARRIER PRESENT, AND
  1578. '                                E.) NO CHECK FOR IMBEDDED CARRIAGE RETURN IN
  1579. '                                       "STRNG$".
  1580. '                                F.) NO SUPPORT FOR XON/XOFF
  1581. '
  1582.       SUB QTPUT (STRNG$,NUM.RETURNS) STATIC
  1583.       IF USE.TPUT THEN _
  1584.          A$ = STRNG$ : _
  1585.          SUBROUTINE.PARAMETER = 4 : _
  1586.          CALL TPUT : _
  1587.          CALL SKIPLINE (NUM.RETURNS) : _
  1588.          EXIT SUB
  1589.       CALL PUTCOM (STRNG$)
  1590.       LOCATE ,,1
  1591.       CALL LPRNT (STRNG$,0)                                ' KG122404
  1592.       CALL SKIPLINE (NUM.RETURNS)
  1593.       END SUB
  1594. ' $SUBTITLE: 'LPRNT    - subroutine to write to display'
  1595. ' $PAGE
  1596. '
  1597. '  SUBROUTINE NAME    -- LPRNT
  1598. '
  1599. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1600. '                        STRNG$        STRING TO WRITE OUT
  1601. '                        NUM.RETURNS   NUMBER OF CARRIAGE RETURNS
  1602. '
  1603. '  OUTPUT PARAMETERS  -- NONE
  1604. '
  1605. '  SUBROUTINE PURPOSE -- SUBROUTINE TO WRITE TO THE DISPLAY.
  1606. '
  1607. 1480  SUB LPRNT (STRNG$,NUM.RETURNS) STATIC
  1608.       IF NOT SNOOP THEN _
  1609.          EXIT SUB
  1610.       CALL PSCRN (STRNG$)
  1611.       IF USE.BASIC.WRITES THEN _
  1612.          FOR I = 1 TO NUM.RETURNS : _
  1613.             PRINT : _
  1614.          NEXT : _
  1615.       ELSE FOR I = 1 TO NUM.RETURNS : _
  1616.               LOCATE ,,1 : _
  1617.               CALL ANSI(CRLF$,C.L,C.C) : _
  1618.               LOCATE C.L,C.C : _
  1619.               NEXT
  1620.       END SUB
  1621. ' $SUBTITLE: 'QLPRNT    - subroutine to quickly write to display'
  1622. ' $PAGE
  1623. '
  1624. '  SUBROUTINE NAME    -- QLPRNT
  1625. '
  1626. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1627. '                        STRNG$        STRING TO WRITE OUT
  1628. '                        NUM           NUMBER OF CARRIAGE RETURNS
  1629. '
  1630. '  OUTPUT PARAMETERS  -- NONE
  1631. '
  1632. '  SUBROUTINE PURPOSE -- SUBROUTINE TO QUICKLY WRITE TO THE DISPLAY.
  1633. '                        OVERWRITES, AND PUTS UP COUNT
  1634.       SUB QLPRNT (STRNG$,NUM) STATIC
  1635.       LOCATE ,1,1
  1636.       CALL LPRNT (STRNG$ + STR$(NUM),0)                       ' KG122405
  1637.       END SUB
  1638. ' $SUBTITLE: 'PSCRN    - subroutine to print to the screen'
  1639. ' $PAGE
  1640. '
  1641. '  SUBROUTINE NAME    -- PSCRN
  1642. '
  1643. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1644. '                        STRNG$        STRING TO WRITE OUT
  1645. '
  1646. '  OUTPUT PARAMETERS  -- NONE
  1647. '
  1648. '  SUBROUTINE PURPOSE -- Assumes you already have positioned
  1649. '                        cursor where you want.
  1650. '
  1651.       SUB PSCRN (STRNG$) STATIC             'KG120905
  1652.       IF STRNG$ = "" THEN _
  1653.          EXIT SUB
  1654.       IF USE.BASIC.WRITES THEN _
  1655.          PRINT STRNG$; _
  1656.       ELSE CALL ANSI (STRNG$,C.L,C.C) : _
  1657.            LOCATE C.L,C.C
  1658.       END SUB
  1659. ' $SUBTITLE: 'SKIPLINE - subroutine to write a blank line to user'
  1660. ' $PAGE
  1661. '
  1662. '  SUBROUTINE NAME    -- SKIPLINE
  1663. '
  1664. '  INPUT PARAMETERS   --   PARAMETER             MEANING
  1665. '                        LOCAL.USER
  1666. '                        MODEM.STATUS.REGISTER
  1667. '                        NUM.RETURNS
  1668. '                        RETURN.LINE.FEED$
  1669. '                        SNOOP
  1670. '
  1671. '  OUTPUT PARAMETERS  -- NONE
  1672. '
  1673. '  SUBROUTINE PURPOSE -- SKIP A LINE ON THE USER'S TERMINAL
  1674. '
  1675.       SUB SKIPLINE (NUM.RETURNS) STATIC
  1676. 1485  FOR I=1 TO NUM.RETURNS
  1677.           CALL PUTCOM (RETURN.LINE.FEED$)
  1678.       NEXT
  1679.       IF NOT SNOOP THEN _
  1680.          GOTO 1486
  1681.       IF USE.BASIC.WRITES THEN _
  1682.          FOR I = 1 TO NUM.RETURNS : _
  1683.             PRINT : _
  1684.          NEXT : _
  1685.       ELSE FOR I = 1 TO NUM.RETURNS : _
  1686.               LOCATE ,,1 : _
  1687.               CALL ANSI(CRLF$,C.L,C.C) : _
  1688.               LOCATE C.L,C.C : _
  1689.               NEXT
  1690. 1486  LINES.PRINTED = LINES.PRINTED + NUM.RETURNS
  1691.       UNIT.COUNT = UNIT.COUNT - DISPLAY.AS.UNIT * NUM.RETURNS
  1692.       END SUB
  1693. ' $SUBTITLE: 'SETCRLF -- subroutine to set up nulls/lf's for output'
  1694. ' $PAGE
  1695. '
  1696. '  SUBROUTINE NAME    -- SETCRLF
  1697. '
  1698. '  INPUT PARAMETERS   --   PARAMETER          MEANING
  1699. '                        CARRIAGE.RETURN$    CARRIAGE RETURN CHARACTER
  1700. '                        LINE.FEED$          LINE FEED CHARACTER
  1701. '                        LINE.FEEDS          LINE FEED SWITCH
  1702. '                        NUL$                NULL CHARACTER
  1703. '
  1704. '  OUTPUT PARAMETERS  -- RETURN.LINE.FEED$   END-OF-LINE STRING
  1705. '
  1706. '  SUBROUTINE PURPOSE -- SET UP THE NECESSARCY NULLS/LINE FEEDS TO END
  1707. '                        EACH OUTPUT TO THE COMMUNICATIONS PORT WITH
  1708. '
  1709.       SUB SETCRLF STATIC
  1710. 1496  RETURN.LINE.FEED$ = _
  1711.          MID$(CARRIAGE.RETURN$,1, - (NOT LOCAL.USER)) + _
  1712.          NUL$ + _
  1713.          MID$(LINE.FEED$,1, - (LINE.FEEDS <> 0))
  1714.       END SUB
  1715. ' $SUBTITLE: 'TGET -- RBBS-PC common routine to ask a user a question'
  1716. ' $PAGE
  1717. '
  1718. '  SUBROUTINE NAME    -- TGET
  1719. '
  1720. '  INPUT PARAMETERS   --    PARAMETER                   MEANING
  1721. '                         SUBROUTINE.PARAMETER = 1  STANDARD ENTRY
  1722. '                         SUBROUTINE.PARAMETER = 2  ENTRY AFTER A FUNCTION KEY
  1723. '                                                   HAS BEEN HANDLED
  1724. '                                A$                 STRING TO WRITE TO THE
  1725. '                                                   COMMUNICATIONS PORT
  1726. '                         HIDDEN                    IF THIS IS TRUE THEN ECHO
  1727. '                                                   '.' INSTEAD OF ACTUAL
  1728. '                                                   CHARACTER ENTERED.
  1729. '                         FORCE.KEYBOARD            IF TRUE, STACKED INPUT
  1730. '                                                   IS BYPASSED AND KEYBOARD
  1731. '                                                   INPUT IS READ.
  1732. '
  1733. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  1734. '                         B$                        STRING THAT WAS ENTERED
  1735. '                         Q                         NUMBER OF PARAMETERES THAT
  1736. '                                                   WERE ENTERED WHICH WHERE
  1737. '                                                   SEPARATED BY A SEMICOLON
  1738. '                         B$()                      STRING MATRIX WITH EACH
  1739. '                                                   ITEM CONTAIN THE STRING
  1740. '                                                   THAT WAS ENTERED BETWEEN
  1741. '                                                   SEMICOLONS.
  1742. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  1743. '                         YES                       REPLY IS "Y" OR "YES"
  1744. '                         NO                        REPLY IS "N" OR "NO"
  1745. '                         NON.STOP                  REPLY IS "NS" OR "ns"
  1746. '                         KILL.MESSAGE              REPLY IS "K"
  1747. '                         REPLY                     REPLY IS "RE"
  1748. '
  1749. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1750. '
  1751.       SUB TGET STATIC
  1752.       ON SUBROUTINE.PARAMETER GOTO 1500,1526
  1753. '
  1754. ' *
  1755. ' *  COMMON INPUT ROUTINE                                                     *
  1756. ' *
  1757. '
  1758. 1500 CALL CARRIER
  1759.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1760.         EXIT SUB
  1761.      LINES.PRINTED = 0
  1762.      DISPLAY.AS.UNIT = FALSE
  1763.      TOA! = FRE("A")
  1764.      CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT)
  1765.      AUTO.WARN! = AUTO.LOGOFF! - 30
  1766.      A = 0
  1767.      B = 0
  1768.      C = 0
  1769.      Q = 1
  1770.      PARM = 0
  1771.      EOL = FALSE
  1772.      YES = FALSE
  1773.      B$ = ""
  1774.      SLEEP.WARN = TRUE
  1775.      NO = FALSE
  1776.      CALL COLORPMT (A$)
  1777.      A$ = A$ + _
  1778.           MID$("? !  ",2*TURBO.KEY+1,2)
  1779.      SUBROUTINE.PARAMETER = 4
  1780.      STOP.SAVE = STOP.INTERRUPTS
  1781.      STOP.INTERRUPTS = TRUE
  1782.      CALL TPUT
  1783.      STOP.INTERRUPTS = STOP.SAVE
  1784.      IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1785.         EXIT SUB
  1786. 1523 IF PROMPT.BELL THEN _
  1787.         IF LOCAL.USER THEN _
  1788.            BEEP_
  1789.         ELSE CALL PUTCOM(BELL.RINGER$)
  1790. 1525 CALL CARRIER
  1791.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1792.         EXIT SUB
  1793.      IF (NOT FORCE.KEYBOARD) AND LEN(COMMPORT.STACK$) > 0 THEN _
  1794.         Y$ = LEFT$(COMMPORT.STACK$,1) : _
  1795.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  1796.         GOTO 1541
  1797.      IF LOCAL.USER THEN _
  1798.         CALL FINDFUNC: _
  1799.         IF SUBROUTINE.PARAMETER < 0 THEN _
  1800.            EXIT SUB _
  1801.         ELSE GOTO 1526
  1802.      CALL EOFCOMM (CHAR%)
  1803.      IF CHAR% <> -1 THEN _
  1804.         CALL GETCOM(Y$) : _
  1805.         IF SUBROUTINE.PARAMETER = -1 THEN _
  1806.            EXIT SUB _
  1807.         ELSE GOTO 1541
  1808.      CALL FINDTIME (TI!)
  1809.      IF TI! > AUTO.WARN! THEN _
  1810.         IF TI! > AUTO.LOGOFF! THEN _
  1811.            CALL UPDTCALR ("Sleep Disconnect",1) :_
  1812.            SUBROUTINE.PARAMETER = -1 : _
  1813.            EXIT SUB _
  1814.         ELSE IF SLEEP.WARN THEN _
  1815.                 SLEEP.WARN = FALSE : _
  1816.                 A$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _
  1817.                 CALL RINGCALLER
  1818.      CALL FINDFUNC
  1819.      IF SUBROUTINE.PARAMETER < 0 THEN _
  1820.         EXIT SUB
  1821. 1526 Y$ = KEY.PRESSED$
  1822.      IF Y$ <> "" THEN _
  1823.         GOTO 1545
  1824.      SEND.REMOTE = TRUE
  1825.      CALL GOIDLE
  1826.      GOTO 1525
  1827. 1541 SEND.REMOTE = REMOTE.ECHO
  1828.      IF TEST.PARITY THEN _
  1829.         GOTO 1542
  1830.      IF Y$ = CHR$(127) THEN _
  1831.         GOTO 1635
  1832.      GOTO 1545
  1833. 1542 IF Y$ = "" THEN _
  1834.         Y$ = " "
  1835.      IF ASC(Y$) = 141 THEN _
  1836.         OUT LINE.CONTROL.REGISTER,&H1A : _
  1837.         EIGHT.BIT = FALSE : _
  1838.         TEST.PARITY = FALSE : _
  1839.         GR = FALSE
  1840.      Y$ = CHR$(ASC(Y$) AND 127)
  1841. 1545 X$ = Y$                                  'KG101503
  1842.      IF INSTR(LINEEDIT.CHK$,Y$) > 5 _
  1843.         GOTO 1635
  1844.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  1845.         GOTO 1525
  1846.      IF Y$ = "^" THEN _
  1847.         GOTO 1525
  1848.      IF Y$ = CARRIAGE.RETURN$ THEN _
  1849.         GOTO 1547 _
  1850.      ELSE GOSUB 1550
  1851.      IF TURBO.KEY < 1 THEN _
  1852.         GOTO 1546
  1853.      IF Y$ = " " THEN _
  1854.         Y$ = ""
  1855.      IF Y$ <> "/" THEN _
  1856.         B$ = Y$ : _
  1857.         Y$ = CARRIAGE.RETURN$ : _
  1858.         X$ = Y$ : _                       'KG101601
  1859.         GOTO 1547
  1860.      TURBO.KEY = 0
  1861.      GOTO 1525
  1862. 1546 IF LEN(B$) => 254 THEN _
  1863.         A$ = "Input too long!" : _
  1864.         SUBROUTINE.PARAMETER = 5 : _
  1865.         CALL TPUT : _
  1866.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1867.            EXIT SUB _
  1868.         ELSE GOTO 1500
  1869.      B$ = B$ + _
  1870.           Y$
  1871.      GOTO 1525
  1872. 1547 TURBO.KEY = FALSE          ' Carriage Return Handler
  1873.      HIDDEN = FALSE
  1874.      IF NO.ADVANCE THEN _
  1875.         NO.ADVANCE = FALSE : _
  1876.         GOTO 1575 _
  1877.      ELSE CALL LPRNT (CRLF$,0) : _
  1878.           GOSUB 1551 : _
  1879.           GOTO 1570
  1880. 1550 IF LOGON.ACTIVE THEN _                                          ' KG101503
  1881.         IF (Y$ = " " OR Y$ = ";") AND _                              ' KG101503
  1882.            RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _        ' KG101503
  1883.               PARM = PARM + 1 : _                                    ' KG101503
  1884.               LOGON.ACTIVE = (PARM < 3) : _                          ' KG101503
  1885.               HIDDEN = (PARM = 2) : _                                ' KG101503
  1886.               CALL LPRNT(X$,0) : _                                   ' KG101503
  1887.               GOTO 1551                                              ' KG101503
  1888. 'Was IF HIDDEN AND LOCAL.USER THEN.....
  1889.      IF HIDDEN THEN _                       'PE 11/04/88
  1890.         X$ = "."                                                     ' KG101503
  1891.      CALL LPRNT(X$,0)                                                ' KG101503
  1892. 1551 IF NOT SEND.REMOTE THEN _
  1893.         RETURN
  1894. 1553 CALL PUTCOM (X$)
  1895.      RETURN
  1896. 1570 IF SEND.REMOTE THEN _
  1897.         IF LINE.FEEDS THEN _
  1898.            CALL PUTCOM (LINE.FEED$)
  1899. 1575 IF LEN(B$) > 4000 THEN _
  1900.         A$ = "Try again, " + _
  1901.              FIRST.NAME$ : _
  1902.         SUBROUTINE.PARAMETER = 5 : _
  1903.         CALL TPUT : _
  1904.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1905.            EXIT SUB _
  1906.         ELSE GOTO 1500
  1907.      IF PARSE.OFF THEN _
  1908.         PARSE.OFF = FALSE : _
  1909.         GOTO 1620
  1910.      CALL PARSEIT
  1911.      IF Q = 1 THEN _
  1912.         GOTO 1622                  'KG012602
  1913.      GOTO 1625
  1914. 1620 B$(1) = B$
  1915.      Q = 1
  1916. 1622  IF B$ = "" THEN _              'KG012602
  1917.         Q = 0 : _
  1918.       HIDDEN = FALSE : _       'KG101502
  1919.         EXIT SUB
  1920. 1625 IF LEN(B$) < 4 THEN _
  1921.         X$ = LEFT$(B$,3): _
  1922.         CALL ALLCAPS (X$) : _
  1923.         IF X$ = "Y" OR X$ = "YES" THEN _
  1924.            YES = TRUE _
  1925.         ELSE IF X$ = "N" OR X$ = "NO" OR X$ = "A" THEN _
  1926.                 NO = TRUE _
  1927.              ELSE IF X$ = "RE" THEN _
  1928.                      REPLY = TRUE : _
  1929.                      EXIT SUB _
  1930.                   ELSE IF X$ = "K" THEN _
  1931.                           KILL.MESSAGE = TRUE : _
  1932.                        EXIT SUB
  1933.      IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
  1934.         NON.STOP = TRUE : _
  1935.         B$(Q) = "" : _
  1936.         IF Q > 1 THEN _
  1937.            Q = Q-1
  1938.      FORCE.KEYBOARD = FALSE
  1939.      HIDDEN = FALSE             'KG101503
  1940.      EXIT SUB
  1941. 1635 IF LEN(B$) = 0 THEN _
  1942.         GOTO 1525
  1943.      IF LOGON.ACTIVE THEN _
  1944.         IF INSTR(" ;",RIGHT$(B$,1)) > 0 THEN _
  1945.            PARM = PARM - 1
  1946.      B$ = LEFT$(B$,LEN(B$)-1)
  1947.      CALL LPRNT(LOCAL.BACKSPACE$,0)
  1948.      IF SEND.REMOTE THEN _
  1949.         CALL PUTCOM(BACKSPACE$)
  1950.      GOTO 1525
  1951.      END SUB
  1952. ' $SUBTITLE: 'RINGCALLER - subroutine to use sound + screen emphasis'
  1953. ' $PAGE
  1954. '
  1955. '  SUBROUTINE NAME    -- RINGCALLER
  1956. '
  1957. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1958. '                         A$                           STRING TO EMPHASIZE
  1959. '
  1960. '  OUTPUT PARAMETERS  --  none
  1961. '
  1962. '  SUBROUTINE PURPOSE --  Rings the users bell before and after string
  1963. '                         (but not snooping sysop) and adds emphasis around
  1964. '                         message sent.
  1965. '
  1966.      SUB RINGCALLER STATIC
  1967.      X$ = LEFT$(BELL.RINGER$,-LOCAL.USER)
  1968.      CALL PUTCOM (BELL.RINGER$)
  1969.      CALL LPRNT (X$,0)
  1970.      SUBROUTINE.PARAMETER = 2
  1971.      A$ = EMPHASIZE.ON$ + A$ + EMPHASIZE.OFF$
  1972.      CALL TPUT
  1973.      CALL PUTCOM (BELL.RINGER$)
  1974.      CALL LPRNT (X$,0)
  1975.      END SUB
  1976. ' $SUBTITLE: 'PARSEIT - subroutine to parse a string'
  1977. ' $PAGE
  1978. '
  1979. '  SUBROUTINE NAME    -- PARSEIT
  1980. '
  1981. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1982. '                         B$                           STRING TO PARSE
  1983. '
  1984. '  OUTPUT PARAMETERS  --  Q                            NUMBER PARSED
  1985. '                         B$()                         PARSED STRINGS
  1986. '
  1987. '  SUBROUTINE PURPOSE --  TO PARSE A STRING INTO PIECES.  USES SEMICOLON
  1988. '                         IF EXISTS, OTHERWISE SPACE
  1989. '
  1990.      SUB PARSEIT STATIC
  1991.      A = INSTR(B$,";")
  1992.      IF A > 0 THEN _
  1993.         PARSE.CHAR$ = ";" _
  1994.      ELSE IF B$ <> SPACE$(LEN(B$)) THEN _
  1995.              CALL TRIM (B$) : _
  1996.              A = INSTR(B$,"  ") : _
  1997.              WHILE A > 0 : _
  1998.                 B$ = LEFT$(B$,A - 1) + _
  1999.                      MID$(B$,A + 1) : _
  2000.                 A = INSTR(A,B$,"  ") : _
  2001.              WEND : _
  2002.              A = INSTR(B$," ") : _
  2003.              PARSE.CHAR$ = " "
  2004.      IF A < 2 THEN _
  2005.         B$(1) = B$ : _
  2006.         EXIT SUB
  2007.      B$(1) = LEFT$(B$,A - 1)
  2008.      A = A + 1
  2009. 1640 B = INSTR(A,B$,PARSE.CHAR$)
  2010.      C = B-A
  2011.      IF C < 1 THEN _
  2012.         EOL = TRUE : _
  2013.         C = 128
  2014.      DF$ = MID$(B$,A,C)
  2015.      IF DF$ <> "" THEN _
  2016.         Q = Q + 1 : _
  2017.         B$(Q) = DF$
  2018.      IF NOT EOL AND Q < 20 THEN _             'KG120403
  2019.         A = B + 1 : _
  2020.         GOTO 1640
  2021.      END SUB
  2022. ' $SUBTITLE: 'SETBAUD - subroutine to set the baud rate in the RS232'
  2023. ' $PAGE
  2024. '
  2025. '  SUBROUTINE NAME    -- SETBAUD
  2026. '
  2027. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2028. '                         BAUD.RATE.DIVISOR   NUMBER TO DIVIDE THE 8250 CHIP'S
  2029. '                                             PROGRAMABLE CLOCK TO ADJUST THE
  2030. '                                             BAUD RATE TO THE USER'S BAUD
  2031. '                                             RATE (INDEPENDENT OF THE BAUD
  2032. '                                             RATE USED TO OPEN THE COMM. PORT)
  2033. '
  2034. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2035. '            RATE              PCjr         PC AND XT
  2036. '              50             2237             2304
  2037. '              75             1491             1536
  2038. '             110             1017             1047
  2039. '             134.5            832              857
  2040. '             150              746              768
  2041. '             300              373              384
  2042. '             600              186              192
  2043. '            1200               93               96
  2044. '            1800               62               64
  2045. '            2000               56               58
  2046. '            2400               47               48
  2047. '            3600               31               32
  2048. '            4800               23               24
  2049. '            7200          not available         16
  2050. '            9600          not available         12
  2051. '           19200          not available          6
  2052. '  OUTPUT PARAMETERS  -- BAUD RATE SET IN THE RS232 INTERFACE
  2053. '
  2054. '  SUBROUTINE PURPOSE -- TO SET THE BAUD RATE IN THE RS232 INTERFACE
  2055. '                        INDEPENDENT OF THE BAUD RATE THE COMMUNICATIONS PORT
  2056. '                        WAS OPENED AT
  2057. '
  2058.       SUB SETBAUD STATIC
  2059. 1654 IF KEEP.INIT.BAUD > -1 THEN _                                   ' WM042201
  2060.   IF KEEP.INIT.BAUD = 0 OR BPS > -5 THEN _                     ' WM042201
  2061.    TALK.TO.MODEM.AT$ =  MID$("      300  450 1200 2400 4800 960019200", _ ' WM042201
  2062.                                     (-5 * BPS),5) _                  ' WM042201
  2063.      ELSE TALK.TO.MODEM.AT$ = MODEM.INIT.BAUD$
  2064.      CALL TRIM (TALK.TO.MODEM.AT$)
  2065.      IF LEN(TALK.TO.MODEM.AT$) < 5 THEN _
  2066.         TALK.TO.MODEM.AT$ = SPACE$(4 - LEN(TALK.TO.MODEM.AT$)) + _
  2067.                             TALK.TO.MODEM.AT$
  2068.      IF EIGHT.BIT THEN_
  2069.         PARITY% = 2 : _                                    ' NO PARITY
  2070.         DATABITS% = 3 : _                                  ' 8 DATA BITS
  2071.         STOPBITS% = 0 _                                    ' 1 STOP BIT
  2072.      ELSE PARITY% = 3 : _                                  ' EVEN PARITY
  2073.           DATABITS% = 2 : _                                ' 7 DATA BITS
  2074.           STOPBITS% = 0                                    ' 1 STOP BIT
  2075.      COMSPEED% = VAL(TALK.TO.MODEM.AT$)
  2076.      IF FOSSIL THEN _
  2077.         CALL FOSSPEED(COMPORT%,COMSPEED%,PARITY%,DATABITS%,STOPBITS%) : _
  2078.         EXIT SUB
  2079.      IF COMSPEED% = 300 THEN _
  2080.         BAUD.RATE.DIVISOR = &H180 + (11 * (COMPUTER.TYPE = 2))
  2081.      IF COMSPEED% = 450 THEN _
  2082.         BAUD.RATE.DIVISOR = &H100 + (8 * (COMPUTER.TYPE = 2))
  2083.      IF COMSPEED% = 1200 THEN _
  2084.         BAUD.RATE.DIVISOR = &H60 + (3 * (COMPUTER.TYPE = 2))
  2085.      IF COMSPEED% = 2400 THEN _
  2086.         BAUD.RATE.DIVISOR = &H30 + (1 * (COMPUTER.TYPE = 2))
  2087.      IF COMSPEED% = 4800 THEN _
  2088.         BAUD.RATE.DIVISOR = &H18
  2089.      IF COMSPEED% = 9600 THEN _
  2090.         BAUD.RATE.DIVISOR = &HC
  2091.      IF COMSPEED% = 19200 THEN _
  2092.         BAUD.RATE.DIVISOR = &H6
  2093.      MOST.SIGNIFICANT.BYTE = FIX (BAUD.RATE.DIVISOR / 256)
  2094.      LEAST.SIGNIFICANT.BYTE = BAUD.RATE.DIVISOR - (MOST.SIGNIFICANT.BYTE * 256)
  2095.      LINE.CONTROL.STATUS = INP(LINE.CONTROL.REGISTER)
  2096.      MSB.SAVE = INP(MSB)
  2097.      OUT MSB,0
  2098.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OR 128
  2099.      OUT LSB,LEAST.SIGNIFICANT.BYTE
  2100.      OUT MSB,MOST.SIGNIFICANT.BYTE
  2101.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS
  2102.      OUT MSB,MSB.SAVE
  2103.      END SUB
  2104. ' $SUBTITLE: 'MSGTO - subroutine to get who a message is to'
  2105. ' $PAGE
  2106. '
  2107. '  SUBROUTINE NAME    -- MSGTO
  2108. '
  2109. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2110. '                         HIGHEST.USER.RECORD
  2111. '
  2112. '  OUTPUT PARAMETERS  --  MESSAGE.TO$              Who message is to
  2113. '                         RECEIVER.REC.NUM         User record # of who to
  2114. '
  2115. '  SUBROUTINE PURPOSE --  Asks who a message is to and determines if receiver
  2116. '                         exists
  2117. '
  2118.      SUB MSGTO (HIGHEST.USER.RECORD,MESSAGE.TO$,RECEIVER.REC.NUM,FOUND) STATIC
  2119. 2020 IF MESSAGE.TO$ <> "" THEN _
  2120.         GOTO 2032
  2121.      A$ = "To [A]ll,S)ysop, or name"
  2122.      CALL SKIPLINE (1)
  2123.      GOSUB 2033
  2124. ' IF LEN (B$) < 3 THEN _
  2125. '     CALL QTPUT ("Must enter a valid user name ",1) : _
  2126. '      GOTO 2020
  2127.      IF LEN(B$) > 30 THEN _
  2128.         CALL QTPUT (CX$(6)+"30 Char. Max"+CX$(7),1) : _
  2129.         GOTO 2020
  2130. 2030 FOUND = TRUE
  2131.      IF Q = 0 THEN _
  2132.         MESSAGE.TO$ = "ALL" _
  2133.      ELSE CALL ALLCAPS (B$) : _
  2134.           IF B$ = "A" THEN _
  2135.              MESSAGE.TO$ = "ALL" : _
  2136.              EXIT SUB _
  2137.           ELSE IF B$ = "S" THEN _
  2138.              MESSAGE.TO$ = "SYSOP" _
  2139.           ELSE MESSAGE.TO$ = B$
  2140. 2032 IF MESSAGE.TO$ <> "ALL" THEN _
  2141.         IF LEFT$(MESSAGE.TO$,4) <> "ALL " AND _
  2142.            START.HASH = 1 AND (MESSAGE.TO$ = "SYSOP" OR _
  2143.            INSTR(MESSAGE.TO$," ") > 0) THEN _
  2144.            TEMP.HASH.VALUE$ = MESSAGE.TO$ : _
  2145.            CALL WHOCHECK (TEMP.HASH.VALUE$,FOUND,RECEIVER.REC.NUM) : _
  2146.            IF NOT FOUND THEN _
  2147.               Q = 0 : _
  2148.               RECEIVER.REC.NUM = 0 : _                               ' KG011610
  2149.               A$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  2150.               TURBO.KEY = -TURBO.KEY.USER : _
  2151.               GOSUB 2033 : _
  2152.               Z$ = B$(1) : _
  2153.               CALL ALLCAPS (Z$) : _
  2154.               IF Z$ <> "C" THEN _
  2155.                  MESSAGE.TO$ = "": _
  2156.             IF Z$ <> "Q" THEN _
  2157.                   GOTO 2020
  2158.      EXIT SUB
  2159. 2033 SUBROUTINE.PARAMETER = 1
  2160.      CALL TGET
  2161.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2162.         EXIT SUB
  2163.      RETURN
  2164.      END SUB
  2165. ' $SUBTITLE: 'MSGPROT - gets protection wanted for a message'
  2166. ' $PAGE
  2167. '
  2168. '  SUBROUTINE NAME    -- MSGPROT
  2169. '
  2170. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2171. '                         MESSAGE.TO$
  2172. '                         FOUND
  2173. '
  2174. '  OUTPUT PARAMETERS  --  PASSWORD$                Protection desired
  2175. '
  2176. '  SUBROUTINE PURPOSE --  Sets protection desired for a new message
  2177. '
  2178.      SUB MSGPROT (MESSAGE.TO$,FOUND,MESSAGE.PASSWORD$) STATIC
  2179.      IF MESSAGE.TO$ = "ALL" THEN _                                   ' JM110805
  2180.         GOTO 2090                                                    ' JM110805
  2181. 2060 A$ = "Make message [P]ublic, p(R)ivate, (H)elp"
  2182.      GOSUB 2093
  2183.      IF Q = 0 THEN _
  2184.         B$(1) = "P"
  2185.      Z$ = LEFT$(B$(1),1)
  2186.      CALL ALLCAPS (Z$)
  2187.      ON INSTR("RPUH",Z$) GOTO 2075,2090,2075,2070
  2188.      GOTO 2060
  2189. '
  2190. ' **  DISPLAY MESSAGE PROTECT HELP   **
  2191. '
  2192. 2070 CALL BUFFILE (HELP$(3),X)
  2193.      GOTO 2060
  2194. '
  2195. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) **
  2196. '
  2197. 2075 IF MESSAGE.TO$ = "ALL" THEN _
  2198.         CALL QTPUT(CX$(2)+"Msg to"+CX$(5)+" ALL"+CX$(3)+" cannot be private",1) : _
  2199.         GOTO 2060
  2200.      IF Z$ = "U" THEN _
  2201.         GOTO 2088
  2202. 2077 IF NOT FOUND THEN _
  2203.         IF ACTIVE.USER.NAME$ <> "SYSOP" THEN _
  2204.            CALL QTPUT (CX$(1)+"Personal"+CX$(2)+" mail only to active users",1) : _
  2205.            MESSAGE.PASSWORD$ = "" : _
  2206.            EXIT SUB
  2207. 2081 CALL QTPUT (CX$(3)+"Sending"+CX$(2)+" personal mail to "+CX$(4) + MESSAGE.TO$+CX$(7),1)
  2208. 2084 MESSAGE.PASSWORD$ = "^READ^"
  2209.      EXIT SUB
  2210. 2085 A$ = "Password"
  2211.      GOSUB 2094
  2212.      IF Q = 0 THEN _
  2213.         GOTO 2085
  2214.      IF LEN(B$) > L THEN _
  2215.         CALL QTPUT (STR$(L) + " Chars. max",1 ) : _
  2216.         GOTO 2085
  2217.      IF L = 15 AND LEFT$(B$,1) = "!" THEN _
  2218.         CALL QTPUT ("Password can't begin with '!'",1) : _
  2219.         GOTO 2085
  2220.      RETURN
  2221. '
  2222. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) **
  2223. '
  2224. 2088 A$ = "Receiver(s) Must KNOW PASSWORD TO READ msg.  Use password (Y/[N])"
  2225.      GOSUB 2093
  2226.      IF NOT YES THEN _
  2227.         GOTO 2070
  2228.      L = 14
  2229.      A1$ = "!"
  2230.      GOSUB 2085
  2231.      CALL ALLCAPS (B$)
  2232.      GOTO 2092
  2233. '
  2234. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) **
  2235. '
  2236. 2090 L = 15
  2237.      A1$ = ""
  2238.      B$ = "^KILL^"
  2239. 2092 MESSAGE.PASSWORD$ = A1$ + _
  2240.                          B$
  2241.      EXIT SUB
  2242. 2093 TURBO.KEY = -TURBO.KEY.USER
  2243. 2094 SUBROUTINE.PARAMETER = 1
  2244.      CALL TGET
  2245.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2246.         EXIT SUB
  2247.      RETURN
  2248.      END SUB
  2249. ' $SUBTITLE: 'WHOCHECK - Checks whether user exists'
  2250. ' $PAGE
  2251. '
  2252. '  SUBROUTINE NAME    -- WHOCHECK
  2253. '
  2254. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2255. '                         WHO.FIND$                User to find
  2256. '
  2257. '  OUTPUT PARAMETERS  --  WHO.FOUND                Whether user found
  2258. '                         USER.NUM.FOUND           Record # of user
  2259. '
  2260. '  SUBROUTINE PURPOSE --  Validate that user record exists.  Sysop
  2261. '                         counted as found even if lack user record.
  2262. '
  2263. 2250 SUB WHOCHECK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC
  2264.      USER.NUM.FOUND = 0
  2265.      IF START.HASH <> 1 THEN _          'KG101607
  2266.         WHO.FOUND = TRUE : _
  2267.         EXIT SUB
  2268.      WHO.FOUND = FALSE
  2269.      TO.SYSOP = (INSTR(WHO.FIND$,"SYSOP") > 0 OR _
  2270.                  INSTR(WHO.FIND$,SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$) > 0 )
  2271.      CALL OPENUSER (HIGHEST.USER.RECORD)
  2272.      FIELD 5, 128 AS USER.RECORD$
  2273.      IF TO.SYSOP THEN _
  2274.         X$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _
  2275.      ELSE X$ = WHO.FIND$
  2276.      CALL FINDUSER (X$,"",START.HASH,LEN.HASH,_                      ' KG101607
  2277.                     0,0,HIGHEST.USER.RECORD,WHO.FOUND,_              ' KG101607
  2278.                     USER.NUM.FOUND,SL)
  2279.      IF USER.FILE.INDEX > 0 THEN _
  2280.         GET 5, USER.FILE.INDEX
  2281. '********** Orig code *******
  2282. '     IF NOT WHO.FOUND THEN _
  2283. '        IF TO.SYSOP THEN _
  2284. '           WHO.FOUND = TRUE _
  2285. '        ELSE CALL QTPUT (CX$(5)+WHO.FIND$+CX$(6) + " not active user"+CX$(7),1)
  2286. '****** ALIAS Changes next *************
  2287.      IF NOT WHO.FOUND THEN _
  2288.         IF TO.SYSOP THEN _
  2289.        WHO.FOUND = TRUE _
  2290.     ELSE CALL ALIASCHK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) : _  'DGS-ALSMN
  2291.          IF NOT WHO.FOUND THEN _                                 'DGS-ALSMN
  2292.         CALL QTPUT (WHO.FIND$ + " not active user",1)        'DGS-MNMOD
  2293.      END SUB
  2294. ' $SUBTITLE: 'ALIASCHK - Checks whether ALIAS exists'
  2295. ' $PAGE
  2296. '
  2297. '  SUBROUTINE NAME    -- ALIASCHK
  2298. '
  2299. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2300. '                         WHO.FIND$                ALIAS to find
  2301. '
  2302. '  OUTPUT PARAMETERS  --  WHO.FOUND                Whether ALIAS found
  2303. '                         USER.NUM.FOUND           Record # of User
  2304. '
  2305. '  SUBROUTINE PURPOSE --  Validate that ALIAS exists.  Get User Record
  2306. '
  2307. 2257 SUB ALIASCHK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC        'DGS-ALSMN
  2308.      CALL BRKFNAME (MAIN.USER.FILE$,DRV$,PREFIX$,EXT$,TRUE)          '
  2309.      DGS.TEMP = INSTR(GRN$," ")                                      '
  2310.      IF DGS.TEMP > 0 THEN _                                          '
  2311.     DGS.FILE.NAME$ = DRV$ + LEFT$(GRN$,DGS.TEMP-1) + "A.DEF" _   '
  2312.      ELSE DGS.FILE.NAME$ = DRV$ + GRN$ + "A.DEF"                     '
  2313.      CALL FINDIT (DGS.FILE.NAME$)                                    '
  2314.      IF NOT OK THEN _                                                '
  2315.     EXIT SUB                                                     '
  2316.      OPEN "I", 7, DGS.FILE.NAME$                                     '
  2317.      DGS.ALIAS$ = ""                                                 '
  2318.      WHILE DGS.ALIAS$ = "" AND NOT EOF(7)                            '
  2319.     INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$                    '
  2320.     IF DGS.TEMP.ALIAS$ = WHO.FIND$ THEN                          '
  2321.        DGS.ALIAS$ = DGS.USER.NAME$                               '
  2322.     END IF                                                       '
  2323.      WEND                                                            '
  2324.      CLOSE 7                                                         '
  2325.      CALL OPENUSER (HIGHEST.USER.RECORD)                             '
  2326.      FIELD 5, 128 AS USER.RECORD$                                    '
  2327.      CALL FINDUSER (DGS.USER.NAME$,TEMP.INDIV.VALUE$,START.HASH,LEN.HASH,_  '
  2328.             START.INDIV,LEN.INDIV,HIGHEST.USER.RECORD,WHO.FOUND,_   '
  2329.             USER.NUM.FOUND,SL)                                      '
  2330.      END SUB
  2331. ' $SUBTITLE: 'EDITALINE - Edits a line in a message'
  2332. ' $PAGE
  2333. '
  2334. '  SUBROUTINE NAME    -- EDITALINE
  2335. '
  2336. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2337. '                         L                        Line # to edit
  2338. '
  2339. '  OUTPUT PARAMETERS  --  A$(L)                    Edited line
  2340. '
  2341. '  SUBROUTINE PURPOSE --  Edit a line in a message.
  2342. '
  2343.      SUB EDITALINE (L) STATIC
  2344. 2620 A$ = "Line #" + _
  2345.           STR$(L) + _
  2346.           " is:" + _
  2347.           RETURN.LINE.FEED$ + _
  2348.           A$(L)
  2349.      SUBROUTINE.PARAMETER = 3
  2350.      CALL TPUT
  2351.      GOSUB 2695
  2352.      IF NOT EXPERT.USER THEN _
  2353.         CALL QTPUT ("Search & replace",1)
  2354.      A$ = "Search for" + _
  2355.           PRESS.ENTER.EXPERT$
  2356.      PARSE.OFF = TRUE
  2357.      SUBROUTINE.PARAMETER = 1
  2358.      GOSUB 2694
  2359.      IF Q = 0 THEN _
  2360.         EXIT SUB
  2361.      Y$ = LEFT$(B$,1)
  2362.      IF Y$ = RIGHT$(B$,1) THEN _
  2363.         IF LEN(B$) > 2 THEN _
  2364.            X = INSTR(2,B$,Y$) : _
  2365.            IF X < LEN(B$) THEN _
  2366.               IF Y$ < "0" OR (Y$ > "9" AND Y$ < "A") THEN _
  2367.                  B$ = MID$(B$,2,LEN(B$)-2) : _
  2368.                  X = X - 1 : _
  2369.                  GOTO 2622
  2370.      X = INSTR(B$,";")
  2371. 2622 IF X > 0 THEN _
  2372.         X$ = LEFT$(B$,X-1) : _
  2373.         Y$ = RIGHT$(B$,LEN(B$)-X) : _
  2374.         GOTO 2660
  2375.      X$ = B$
  2376.      A$ = "And replace by"
  2377.      PARSE.OFF = TRUE
  2378.      SUBROUTINE.PARAMETER = 1
  2379.      GOSUB 2694
  2380.      Y$ = B$
  2381. 2660 X = INSTR(1,A$(L),X$)
  2382.      IF X = 0 THEN _
  2383.         CALL QTPUT ("<" + X$ + "> not found in line" + STR$(L),1) : _
  2384.         GOTO 2620
  2385. 2670 FF = LEN(X$)
  2386.      JJ = LEN(Y$)
  2387.      IF FF = JJ THEN _
  2388.         MID$(A$(L),X) = Y$ : _
  2389.         GOTO 2620
  2390. 2690 DF$ = LEFT$(A$(L),X - 1)
  2391.      A$(L) = DF$ + _
  2392.              Y$ + _
  2393.              MID$(A$(L),X + FF)
  2394.      GOTO 2620
  2395. 2694 CALL TGET
  2396. 2695 IF SUBROUTINE.PARAMETER > -1 THEN _
  2397.         RETURN
  2398.      END SUB
  2399. ' $SUBTITLE: 'LINEEDIT  - subroutine to produce edited line'
  2400. ' $PAGE
  2401. '
  2402. '  SUBROUTINE NAME    -- LINEEDIT
  2403. '
  2404. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2405. '                        BACK.ARROW$
  2406. '                        BACKSPACE$
  2407. '                        CARRIAGE.RETURN$
  2408. '                        LINE.FEED$
  2409. '                        LINEMES$          BUFFER SPACE TO USE FOR HOLDING LINE
  2410. '                        LOCAL.USER
  2411. '                        MAX.LEN           MAXIMUM LENGTH OF STRING TO INPUT
  2412. '                        MESSAGE.LINE      WHERE IN A$() TO PUT THE EDITED LINE
  2413. '                        RIGHT.MARGIN
  2414. '                        SNOOP
  2415. '                        STOP.INTERRUPTS
  2416. '                        WAIT.EXPIRED
  2417. '
  2418. '  OUTPUT PARAMETERS  -- A$(MESSAGE.LINE)  EDITED LINE
  2419. '
  2420. '  SUBROUTINE PURPOSE -- SUBROUTINE TO EDIT A LINE QUICKLY USING A MINIMUM OF
  2421. '                        STRING SPACE.
  2422. '
  2423.      SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC
  2424. 3700 LSET LINEMES$ = A$(MESSAGE.LINE)
  2425.      COL = LEN(A$(MESSAGE.LINE))
  2426.      STOP.INTERRUPTS = TRUE
  2427.      XXX = MAX.LEN - 3
  2428.      WAIT.EXPIRED = FALSE
  2429. 3720 COL = COL + 1
  2430.      CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT)
  2431. 3730 CALL FINDFUNC                'KG110801
  2432.      IF SUBROUTINE.PARAMETER < 0 THEN _
  2433.         EXIT SUB
  2434.      X$ = KEY.PRESSED$
  2435.      IF X$ = "" THEN _
  2436.         IF LOCAL.USER THEN _
  2437.            GOTO 3730 _
  2438.         ELSE GOTO 3732
  2439.      IF X$ = ESCAPE$ THEN _
  2440.         KEY.PRESSED$ = X$ : _
  2441.         EXIT SUB
  2442.      SEND.REMOTE = TRUE
  2443.      Z = INSTR(LINEEDIT.CHK$,X$)
  2444.      IF Z < 1 THEN _
  2445.         GOTO 3750 _
  2446.      ELSE IF Z > 4 THEN _
  2447.              GOTO 3870
  2448.      IF LOCAL.USER THEN _
  2449.         GOTO 3730
  2450. 3732 IF COMMPORT.STACK$ <> "" THEN _
  2451.         X$ = LEFT$(COMMPORT.STACK$,1) : _
  2452.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  2453.         GOTO 3738
  2454.      CALL EOFCOMM (CHAR%)
  2455.      IF CHAR% <> -1 THEN _
  2456.         GOTO 3736
  2457.      CALL FINDTIME (TI!)
  2458.      IF TI! > AUTO.LOGOFF! THEN _
  2459.         WAIT.EXPIRED = TRUE : _
  2460.         EXIT SUB
  2461. 3733 CALL CARRIER
  2462.      IF SUBROUTINE.PARAMETER THEN _
  2463.         EXIT SUB
  2464.      GOTO 3730
  2465. 3736 AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  2466. 3737 CALL GETCOM (X$)
  2467. 3738 SEND.REMOTE = REMOTE.ECHO
  2468. 3740 ON INSTR(LINEEDIT.CHK$,X$) GOTO 3730,3730,3730,3730,3870,3870,3870,3870,3870
  2469. 3750 IF SEND.REMOTE THEN _
  2470.         CALL PUTCOM(X$)
  2471.      CALL LPRNT (X$, 0)
  2472.      IF X$ = CARRIAGE.RETURN$ THEN _
  2473.         COL = COL - 1 : _
  2474.         GOTO 3850
  2475. 3770 IF COL > XXX THEN _
  2476.         IF X$ = " " THEN _
  2477.            CALL SKIPLINE (1) : _
  2478.            GOTO 3860
  2479. 3780 MID$(LINEMES$,COL) = X$
  2480.      IF COL < MAX.LEN THEN _
  2481.         GOTO 3720
  2482.      Z = COL
  2483. 3800 IF Z < 1 THEN _
  2484.         Z = COL-1 : _
  2485.         GOTO 3820
  2486.      IF MID$(LINEMES$,Z,1) = " " THEN _
  2487.         GOTO 3820
  2488.      Z = Z - 1
  2489.      GOTO 3800
  2490. 3820 IF (NOT REMOTE.ECHO) AND (NOT LOCAL.USER) THEN _
  2491.         CALL SKIPLINE (1) : _
  2492.         GOTO 3860
  2493.      COL = MAX.LEN - Z
  2494.      IF SNOOP THEN _
  2495.         IF POS(0) > COL THEN _
  2496.            LOCATE ,POS(0)-COL: _
  2497.            CALL LPRNT(STRING$(COL,32),0)
  2498. 3830 IF REMOTE.ECHO THEN _
  2499.         CALL PUTCOM (STRING$(COL,8) + STRING$(COL,32))
  2500. 3840 A$(MESSAGE.LINE) = LEFT$(LINEMES$,Z)
  2501.      A$(MESSAGE.LINE + 1) = MID$(LINEMES$,Z + 1,COL)
  2502.      CALL SKIPLINE (1)
  2503.      GOTO 3891
  2504. 3850 IF SEND.REMOTE AND LINE.FEEDS THEN _
  2505.         CALL PUTCOM(LINE.FEED$)
  2506. 3860 A$(MESSAGE.LINE) = LEFT$(LINEMES$,COL)
  2507.      GOTO 3891
  2508. 3870 IF COL = 1 THEN _
  2509.         GOTO 3730
  2510.      COL = COL-2
  2511. 3880 CALL LPRNT(LOCAL.BACKSPACE$,0)
  2512. 3885 IF SEND.REMOTE THEN _
  2513.         CALL PUTCOM (BACKSPACE$)
  2514. 3890 GOTO 3720
  2515. 3891 CALL CARRIER
  2516.      END SUB
  2517. ' $SUBTITLE: 'KILLMSG - subroutine to delete messages'
  2518. ' $PAGE
  2519. '
  2520. '  SUBROUTINE NAME    -- KILLMSG
  2521. '
  2522. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2523. '                         MESSAGE.TO.KILL              MESSAGE NUMBER TO KILL
  2524. '                         ACTIVE.MESSAGES              NUMBER ACTIVE MESSAGES
  2525. '
  2526. '  OUTPUT PARAMETERS  --  NONE
  2527. '
  2528. '  SUBROUTINE PURPOSE --  TO KILL/DELETE OLD OR UNNECESSARY MESSAGES
  2529. '
  2530.      SUB KILLMSG (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) STATIC
  2531. '
  2532.      FIELD #1,128 AS MESSAGE.RECORD$
  2533.      QX = 1
  2534. 3955 IF QX > ACTIVE.MESSAGES THEN _
  2535.         A$ = "No such msg #" + _
  2536.              STR$(MESSAGE.TO.KILL) : _
  2537.         GOTO 4031
  2538.      IF M(QX,2) = MESSAGE.TO.KILL AND MESSAGE.TO.KILL => 1 THEN _
  2539.         GOTO 3970
  2540.      QX = QX + 1
  2541.      GOTO 3955
  2542. 3970 SUBROUTINE.PARAMETER = 3
  2543.      CALL FILELOCK
  2544.      GET 1,M(QX,1)
  2545.      IF SYSOP THEN _
  2546.         GOTO 4030
  2547. 3980 Z$ = MID$(MESSAGE.RECORD$,101,15)
  2548.      CALL TRIM (Z$)
  2549.      IF LEN(Z$) = 0 THEN _
  2550.         GOTO 4030
  2551. 3990 IF Z$ = "^READ^" OR Z$ = "^KILL^" THEN _
  2552.         IF INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) THEN _
  2553.            GOTO 4030 _
  2554.         ELSE MESSAGE.PASSWORD = TRUE : _
  2555.              ATTEMPTS.ALLOWED = 0 : _
  2556.              A$ = "Only sender & receiver can kill" : _    'KG011804
  2557.              GOTO 4031
  2558. 4000 IF LEFT$(Z$,1) = "!" THEN _
  2559.         Z$ = MID$(Z$,2)
  2560. 4010 PASSWORD.SAVE$ = Z$ + _
  2561.                       SPACE$(15 - LEN(Z$))
  2562.      ATTEMPTS.ALLOWED = 1
  2563.      MESSAGE.PASSWORD = TRUE
  2564.      CALL PASSWRD
  2565.      IF PASSWORD.FAILED THEN _
  2566.         GOTO 4031
  2567. 4030 LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _
  2568.                             DELETED.MESSAGE$ + _
  2569.                             MID$(MESSAGE.RECORD$,117)
  2570.      PUT 1,LOC(1)
  2571.      A$ = CX$(1)+"Killed Msg # " +CX$(3)+ _
  2572.           STR$(MESSAGE.TO.KILL)+CX$(7)
  2573.      CALL THREAD2 (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$)  'PE 01/12/89
  2574.      SUBROUTINE.PARAMETER = 4
  2575.      CALL FILELOCK                                'KG011804 
  2576.      SUBROUTINE.PARAMETER = 5
  2577.      CALL TPUT
  2578.      EXIT SUB
  2579. 4031 SUBROUTINE.PARAMETER = 5
  2580.      CALL TPUT
  2581.      END SUB
  2582. ' $SUBTITLE: 'SETTHREAD - Sets up the interface for threading'
  2583. ' $PAGE
  2584. '
  2585. '  SUBROUTINE NAME    -- SETTHREAD
  2586. '
  2587. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2588. '                          CURR.MSG.NUM          Current message number
  2589. '                          CURR.SUBJ$            Current message subject
  2590. '
  2591. '  OUTPUT PARAMETERS  --  B$()                   Search msg by string
  2592. '                         Q                      0 if thread cancelled
  2593. '
  2594. '  SUBROUTINE PURPOSE --  Find out how the caller wants to thread -
  2595. '                         i.e. search messages by matching subject -
  2596. '                         forward from current, back from current,
  2597. '                         or forward from top of messages
  2598. '
  2599.      SUB SETTHREAD (CURR.MSG.NUM,CURR.SUBJ$) STATIC
  2600.      IF Q > 1 THEN _
  2601.         Z$ = B$(2) : _
  2602.         GOTO 4657
  2603. 4656 A$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)" 'Pe 02/11/89
  2604.      TURBO.KEY = -TURBO.KEY.USER
  2605.      SUBROUTINE.PARAMETER = 1
  2606.      CALL TGET
  2607.      IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _
  2608.         EXIT SUB
  2609.      Z$ = B$(1)
  2610. 4657 Z$ = LEFT$(Z$,1)
  2611.      X = INSTR("+-1",Z$)
  2612.      IF X = 0 THEN _
  2613.         GOTO 4656
  2614.      B$(1) = "R"
  2615.      IF X = 1 THEN _
  2616.         CURR.MSG.NUM = CURR.MSG.NUM + 1 _
  2617.      ELSE IF X = 2 THEN _
  2618.              CURR.MSG.NUM = CURR.MSG.NUM - 1 _
  2619.           ELSE CURR.MSG.NUM = 1 : _
  2620.                Z$ = "+"
  2621.      B$(3) = MID$(STR$(CURR.MSG.NUM),2) + Z$
  2622.      IF LEN(CURR.SUBJ$) < 4 OR LEFT$(CURR.SUBJ$,3) <> "(R)" THEN _
  2623.         B$(2) = CURR.SUBJ$ _
  2624.      ELSE B$(2) = MID$(CURR.SUBJ$,4)
  2625.      B$(2) = CHR$(34) + B$(2) + CHR$(34)
  2626.      Q = 3
  2627.      END SUB
  2628. ' $SUBTITLE: 'SYSOPCHAT - chat with sysop'
  2629. ' $PAGE
  2630. '
  2631. '  SUBROUTINE NAME    -- SYSOPCHAT
  2632. '
  2633. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2634. '  OUTPUT PARAMETERS  --  CM                     True if chat active
  2635. '
  2636. '  SUBROUTINE PURPOSE --  Lets sysop chat interactively with caller
  2637. '
  2638.      SUB SYSOPCHAT STATIC                                            ' KG102406
  2639.      CM = TRUE                                                       ' KG102406
  2640.      CALL FINDTIME (TIME.CHAT.STARTED!)                              ' KG102406
  2641.      SUBROUTINE.PARAMETER = 1                                        ' KG102406
  2642.      CALL LINE25                                                     ' KG102406
  2643.      A$(2) = ""                                                      ' KG102406
  2644. 4775 CALL LINEEDIT (1,72)                                            ' KG102406
  2645.      IF KEY.PRESSED$ = ESCAPE$ OR _                                  ' KG102406
  2646.         SUBROUTINE.PARAMETER < 0 THEN _                              ' KG102406
  2647.         GOTO 4777                                                    ' KG102406
  2648.      A$(1) = ""                                                      ' KG102406
  2649.      IF A$(2) <> "" THEN _                                           ' KG102406
  2650.         A$ = A$(2) : _                                               ' KG102406
  2651.         A$(1) = A$(2) : _                                            ' KG102406
  2652.         A$(2) = "" _                                                 ' KG102406
  2653.      ELSE A$ = ""                                                    ' KG102406
  2654.      SUBROUTINE.PARAMETER = 4                                        ' KG102406
  2655.      CALL TPUT                                                       ' KG102406
  2656.      IF SUBROUTINE.PARAMETER > -1 THEN _                             ' KG102406
  2657.         GOTO 4775                                                    ' KG102406
  2658. 4777 CM = 0                                                          ' KG102406
  2659.      CALL FINDTIME (TI!)                                             ' KG102406
  2660.      ELAPSED! = FIX(TI! - TIME.CHAT.STARTED!)                        ' KG102406
  2661.      IF ELAPSED! < 0 THEN _                                          ' KG102406
  2662.         ELAPSED! = TI! + (86400! - TIME.CHAT.STARTED!)               ' KG102406
  2663.      SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + ELAPSED!          ' KG102406
  2664.      IF NOT LOCAL.USER THEN _                                        ' KG102406
  2665.         AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT                  ' KG102406
  2666.      CALL QTPUT("  Chat ended.  Returning to normal operation",2)    ' KG102406
  2667.      END SUB                                                         ' KG102406
  2668. ' $SUBTITLE: 'REMNONALF - removes non-alpha characters from a string'
  2669. ' $PAGE
  2670. '
  2671. '  SUBROUTINE NAME    -- REMNONALF
  2672. '
  2673. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2674. '                              STRNG$                   String to check
  2675. '                              MIN.CHAR            Remove chars with this
  2676. '                                                   ASCII value or lower
  2677. '                              MAX.CHAR            Remove chars with this
  2678. '                                                   ASCII value or higher
  2679. '
  2680. '  OUTPUT PARAMETERS  --       STRNG$                   String returned
  2681. '  SUBROUTINE PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2682. '
  2683. 5100 SUB REMNONALF (STRNG$,MIN.CHAR,MAX.CHAR) STATIC
  2684.      LAST = LEN(STRNG$)
  2685.      J = 1
  2686.      WHILE J <= LAST
  2687.         K = ASC(MID$(STRNG$,J))
  2688.         IF K > MIN.CHAR AND K < MAX.CHAR THEN _
  2689.            J = J + 1 _
  2690.         ELSE STRNG$ = LEFT$(STRNG$,J - 1) + _
  2691.                       RIGHT$(STRNG$,LAST - J) : _
  2692.              LAST = LAST - 1
  2693.      WEND
  2694.      END SUB
  2695. ' $SUBTITLE: 'PAGELEN - Sets lines per page'
  2696. ' $PAGE
  2697. '
  2698. '  SUBROUTINE NAME    -- PAGELEN
  2699. '
  2700. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2701. '                         PAGE.LENGTH              Current page length
  2702. '
  2703. '  OUTPUT PARAMETERS  --  PAGE.LENGTH              New page length
  2704. '
  2705. '  SUBROUTINE PURPOSE --  Change default lines per page
  2706. '
  2707.      SUB PAGELEN STATIC
  2708. 5202 A$ = "CHANGE page length from" + _
  2709.           STR$(PAGE.LENGTH) + _
  2710.           " TO (0-255, 0=continuous)"
  2711.      SUBROUTINE.PARMETER = 5
  2712.      CALL TGET
  2713.      IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _
  2714.         CALL QTPUT ("No change",1) : _
  2715.         EXIT SUB
  2716. 5230 CALL CHECKINT (B$(Q))
  2717.      IF EC <> 0 THEN _
  2718.         GOTO 5202
  2719.      IF TESTED.INTEGER.VALUE < 0 OR _
  2720.         TESTED.INTEGER.VALUE > 255 THEN _
  2721.         GOTO 5202
  2722.      PAGE.LENGTH = TESTED.INTEGER.VALUE
  2723.      CALL QTPUT ("Set to" + STR$(PAGE.LENGTH),1)
  2724.      END SUB
  2725. ' $SUBTITLE: 'BAUD450 -- Changes 300 baud to 450'
  2726. ' $PAGE
  2727. '  SUBROUTINE NAME    -- BAUD450
  2728. '
  2729. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2730. '                        BPS
  2731. '
  2732. '  OUTPUT PARAMETERS  -- BPS
  2733. '
  2734. '  SUBROUTINE PURPOSE -- ALLOW 300 BAUD MODEMS TO BUMP UP TO 450 BAUD
  2735. '
  2736.      SUB BAUD450 STATIC
  2737. 5507
  2738. 5510
  2739. 5530
  2740. 5535
  2741. 5536
  2742. 5537
  2743. 5540 END SUB
  2744. ' $SUBTITLE: 'GETIME - subroutine to calculate elapsed time'
  2745. ' $PAGE
  2746. '
  2747. '  SUBROUTINE NAME    -- GETIME
  2748. '
  2749. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2750. '                         TIME.LOGGED.ON$
  2751. '
  2752. '  OUTPUT PARAMETERS  --  HH                     NUMBER OF HOURS ON
  2753. '                         MM                     NUMBER OF MINUTES ON
  2754. '                         SS                     NUMBER OF SECONDS ON
  2755. '
  2756. '  SUBROUTINE PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2757. '
  2758.      SUB GETIME STATIC
  2759. 9140 H = VAL(MID$(TIME.LOGGED.ON$,1,2))
  2760.      M = VAL(MID$(TIME.LOGGED.ON$,4,2))
  2761.      S = VAL(MID$(TIME.LOGGED.ON$,7,2))
  2762.      X$ = TIME$
  2763.      HH = VAL(MID$(X$,1,2))
  2764.      MM = VAL(MID$(X$,4,2))
  2765.      JJ = VAL(MID$(X$,7,2))
  2766.      IF S <= JJ THEN _
  2767.         SSS = JJ - S _
  2768.      ELSE SSS = 60 - (S - JJ) : _
  2769.           M = M + 1
  2770. 9150 IF M <= MM THEN _
  2771.         MMM = MM - M _
  2772.      ELSE MMM = 60 - (M - MM) : _
  2773.           H = H + 1
  2774. 9160 IF H <= HH THEN _
  2775.         HHH = HH - H _
  2776.      ELSE HHH = 24 - (H - HH)
  2777.      END SUB
  2778. ' $SUBTITLE: 'DEFAULTU - subroutine to update user defauts'
  2779. ' $PAGE
  2780. '
  2781. '  SUBROUTINE NAME    -- DEFAULTU
  2782. '
  2783. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2784. '                         AUTODOWNLOAD.DESIRED
  2785. '                         BOLD.TEXT$              Ansi bold (0 no, 1 yes)
  2786. '                         CHECK.BULLETIN.LOGON
  2787. '                         EXPERT.USER
  2788. '                         GR
  2789. '                         LAST.MESSAGE.READ
  2790. '                         LINE.FEEDS
  2791. '                         NULLS
  2792. '                         PAGE.LENGTH
  2793. '                         PROMPT.BELL
  2794. '                         REG.DATE$
  2795. '                         REQ.QUES.ANSWERED
  2796. '                         RIGHT.MARGIN
  2797. '                         SKIP.FILES.LOGON
  2798. '                         TIMES.LOGGED.ON
  2799. '                         UPPER.CASE
  2800. '                         USER.OPTIONS$
  2801. '                         USER.TEXT.COLOR          Ansi of color (31-37)
  2802. '                         USER.TRANSFER.DEFAULT$
  2803. '
  2804. '  OUTPUT PARAMETERS  --  USER.OPTONS$
  2805. '
  2806. '  SUBROUTINE PURPOSE --  TO UPDATE THE USER'S RECORD WITH THEIR OPTIONS
  2807. '  Meaning of graphics preference stored is as follows: where # is
  2808. '  value stored for the color.  E.g. if graphics perference for text
  2809. '  files is color, and preference for normal text is light yellow,
  2810. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  2811. '  Blue, Purple, Cyan, and White.
  2812. '
  2813. '             normal                  bold
  2814. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  2815. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  2816. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  2817. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  2818. '
  2819. '
  2820.      SUB DEFAULTU STATIC
  2821. 9600 A =        -PROMPT.BELL           -2 * EXPERT.USER _
  2822.             -4 * NULLS                 -8 * UPPER.CASE _
  2823.            -16 * LINE.FEEDS           -32 * CHECK.BULLETIN.LOGON _
  2824.            -64 * SKIP.FILES.LOGON    -128 * AUTODOWNLOAD.DESIRED _
  2825.           -256 * REQ.QUES.ANSWERED   -512 * MAIL.WAITING _
  2826.          -1024 * (NOT HIGHLIGHT.OFF)-2048 * TURBO.KEY.USER
  2827.    X = 3 * USER.TEXT.COLOR - 63 + 21*VAL(BOLD.TEXT$) + GR
  2828.      IF X < 1 OR X > 255 THEN _
  2829.         X = 48
  2830.      LSET USER.OPTIONS$ = _
  2831.         MKI$(TIMES.LOGGED.ON) + _
  2832.         MKI$(LAST.MESSAGE.READ) + _
  2833.         USER.TRANSFER.DEFAULT$ + _
  2834.         CHR$(X) + _
  2835.         MKI$(RIGHT.MARGIN) + _
  2836.         MKI$(A) + _
  2837.         REG.DATE$ + _
  2838.         CHR$(PAGE.LENGTH) + _
  2839.         ECHOER$
  2840. 'PRINT PROMPT.BELL
  2841. 'PRINT A
  2842. 'CALL DELAYIT(2)
  2843.      END SUB
  2844. ' $SUBTITLE: 'WHOSON - subroutine to display who is on'
  2845. ' $PAGE
  2846. '
  2847. '  SUBROUTINE NAME    -- WHOSON
  2848. '
  2849. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2850. '                         NUM.NODES                   # of nodes to check
  2851. '                         ACTIVE.MESSAGE.FILE$        Current message file
  2852. '                         ORIG.MESSAGE.FILE$          Main msg file
  2853. '
  2854. '  OUTPUT PARAMETERS  --  None
  2855. '
  2856. '  SUBROUTINE PURPOSE --  To display who is on each node.
  2857. '
  2858. 9801 SUB WHOSON (NUM.NODES) STATIC
  2859.      A1$ = ACTIVE.MESSAGE.FILE$
  2860.      ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  2861.      CALL OPENMSG
  2862.      FIELD 1, 128 AS MESSAGE.RECORD$
  2863.      FOR NODE.INDEX = 2 TO NUM.NODES + 1
  2864.         GET 1,NODE.INDEX
  2865.         A$ = FG.1$ + "Node" + _
  2866.              STR$(NODE.INDEX - 1) + FG.2$
  2867.         REC.INDEX = VAL(MID$(MESSAGE.RECORD$,44,2))
  2868.         IF REC.INDEX = 0 THEN _
  2869.            REC.INDEX = -1
  2870.         AX$ = MID$("      300  450 1200 2400 4800 960019200",(-5 * REC.INDEX ),5) + _
  2871.               " BAUD: "
  2872.         IF MID$(MESSAGE.RECORD$,55,2) = "-1" AND NOT SYSOP THEN _
  2873.            Y$ = "SYSOP" + SPACE$(21) _
  2874.         ELSE Y$ = MID$(MESSAGE.RECORD$,1,26)
  2875.         AX$ = AX$ + FG.3$ + Y$
  2876.         IF MID$(MESSAGE.RECORD$,40,2) <> "-1" THEN _
  2877.            AX$ = AX$ + FG.4$ + MID$(MESSAGE.RECORD$,93,22)
  2878.         IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _
  2879.            A$ = A$ + "  Online at " + _
  2880.                 AX$ _
  2881.         ELSE IF NOT SYSOP THEN _
  2882.                 A$ = A$ + _
  2883.                      " Waiting for next caller" _
  2884.              ELSE A$ = A$ + _
  2885.                        " Offline at " + _
  2886.                        AX$
  2887.         CALL QTPUT (A$,1)
  2888.      NEXT
  2889.      ACTIVE.MESSAGE.FILE$ = A1$
  2890.      END SUB
  2891. ' $SUBTITLE: 'RECOVMSG - subroutine to recover deleted messages'
  2892. ' $PAGE
  2893. '
  2894. '  SUBROUTINE NAME    -- RECOVMSG
  2895. '
  2896. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2897. '                         MESSAGE.TO.RECOVER          MESSAGE NUMBER TO RECOVER
  2898. '                         FIRST.MESSAGE.RECORD        RECORD # FOR FIRST MSG
  2899. '
  2900. '  OUTPUT PARAMETERS  --  ACTION.FLAG                 SET TO 0 IF ERROR
  2901. '                                                     SET TO -1 IF NO ERROR
  2902. '
  2903. '  SUBROUTINE PURPOSE --  TO RECOVER DELETED MESSAGES.  NOTE THAT THIS IS ONLY
  2904. '                         POSSIBLE IF YOU HAVE NOT COMPRESSED YOUR MESSAGE FILE
  2905. '                         USING CONFIG.
  2906.       SUB RECOVMSG (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG,GRN$) STATIC  'pe/01/12/89
  2907.       FIELD #1,128 AS MESSAGE.RECORD$
  2908. 10410 MESSAGE.RECORD = FIRST.MESSAGE.RECORD
  2909.       SUBROUTINE.PARAMETER = 5
  2910.       CALL TPUT
  2911. 10420 GET 1,MESSAGE.RECORD
  2912.       NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,117,4))
  2913.       IF NUMBER.RECORDS.IN.MESSAGE < 1 THEN _
  2914.          A$ = "USE CONFIG TO REPAIR YOUR MESSAGE FILE" : _
  2915.          GOTO 10485
  2916.       IF MESSAGE.RECORD => NEXT.MESSAGE.RECORD THEN _
  2917.          A$ = "No Msg #" + _
  2918.               STR$(MESSAGE.TO.RECOVER) : _
  2919.          GOTO 10485
  2920. 10440 IF VAL(MID$(MESSAGE.RECORD$,2,4)) <> MESSAGE.TO.RECOVER THEN _
  2921.          MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE : _
  2922.          GOTO 10420
  2923. 10450 IF INSTR(MESSAGE.RECORD$,DELETED.MESSAGE$) <> 0 THEN _
  2924.          SUBROUTINE.PARAMETER = 3 : _
  2925.          CALL TPUT : _
  2926.          LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _
  2927.                                 ACTIVE.MESSAGE$ + _
  2928.                                 MID$(MESSAGE.RECORD$,117) : _
  2929.          PUT 1,LOC(1) : _
  2930.          SUBROUTINE.PARAMETER = 4 : _
  2931.          CALL TPUT : _
  2932.          A$ = "Restored Msg #" + _
  2933.               STR$(MESSAGE.TO.RECOVER) : _
  2934.          ACTION.FLAG = TRUE : _
  2935.      CALL THREAD4 (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG,GRN$) : _ 
  2936.          GOTO 10485
  2937. 10480 A$ = "Msg #" + _
  2938.            STR$(MESSAGE.TO.RECOVER) + _
  2939.            " not Dead"
  2940. 10485 CALL QTPUT (A$,1)
  2941.       END SUB
  2942. ' $SUBTITLE: 'UPDATEU -- Update the users record at logoff'
  2943. ' $PAGE
  2944. '  SUBROUTINE NAME    -- UPDATEU
  2945. '
  2946. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2947. '                        ADJUSTED.SECURITY
  2948. '                        CURRENT.DATE$
  2949. '                        DOWNLOADS
  2950. '                        ELAPSED.TIME
  2951. '                        LIST.DIRECTORY
  2952. '                        MAIN.USER.FILE.INDEX
  2953. '                        SECONDS.PER.SESSION!
  2954. '                        UPLOADS
  2955. '                        USER.SECURITY.LEVEL
  2956. '
  2957. '  OUTPUT PARAMETERS  -- ELAPSED.TIME$
  2958. '                        LIST.NEW.DATE$
  2959. '                        SECURITY.LEVEL$
  2960. '                        USER.DOWNLOADS$
  2961. '                        USER.UPLOADS$
  2962. '
  2963. '  SUBROUTINE PURPOSE -- UPDATE THE USER RECORD FOR THE USER WHEN THE USER
  2964. '                        EXITS RBBS-PC.
  2965. '
  2966.       SUB UPDATEU (LOGGING.OFF) STATIC
  2967.       IF ACTIVE.USER.NAME$ = "" OR FIRST.NAME$ = "" THEN _
  2968.          EXIT SUB
  2969.       IF ACTIVE.USER.FILE$ = ORIG.USER.FILE$ THEN _                  ' KG102004
  2970.          UPLOADS = GLOBAL.UPLOADS : _                                ' KG102004
  2971.          DOWNLOADS = GLOBAL.DOWNLOADS : _                            ' KG102004
  2972.          DL.TODAY! = GLOBAL.DL.TODAY! : _                            ' KG102004
  2973.          BYTES.TODAY! = GLOBAL.BYTES.TODAY! : _                      ' KG102004
  2974.          DLBYTES! = GLOBAL.DLBYTES! : _                              ' KG102004
  2975.          ULBYTES! = GLOBAL.ULBYTES!                                  ' KG102004
  2976. 10600 CALL TIMEREMAIN (TIME.REMAINING!)
  2977.       Q! = ELAPSED.TIME + MINUTES.IN.DOORS + _
  2978.            ((SECONDS.PER.SESSION! - TIME.CREDITS!)/ 60) - _
  2979.            TIME.REMAINING!
  2980.       IF Q! < -32000 THEN _
  2981.          Q! = -32000 _
  2982.       ELSE IF Q! > 32000 THEN _
  2983.          Q! = 32000
  2984.       IF USER.FILE.INDEX < 1 THEN _
  2985.          GOTO 10607
  2986.       UPDATE.DEFAULTS = TRUE
  2987. 10602 SUBROUTINE.PARAMETER = 6
  2988.       CALL FILELOCK
  2989.       CALL OPENUSER (HIGHEST.USER.RECORD)
  2990.       FIELD 5,31 AS USER.NAME$, _
  2991.               15 AS PASSWORD$, _
  2992.                2 AS SECURITY.LEVEL$, _
  2993.               14 AS USER.OPTIONS$,  _
  2994.               24 AS CITY.STATE$, _
  2995.               3 AS MACHINE.TYPE$, _
  2996.               4 AS TODAY.DL$, _
  2997.               4 AS TODAY.BYTES$, _
  2998.               4 AS DL.BYTES$, _
  2999.               4 AS UL.BYTES$, _
  3000.               14 AS LAST.DATE.TIME.ON$, _
  3001.                3 AS LIST.NEW.DATE$, _
  3002.                2 AS USER.DOWNLOADS$, _
  3003.                2 AS USER.UPLOADS$, _
  3004.                2 AS ELAPSED.TIME$
  3005. 10604  GET 5,USER.FILE.INDEX
  3006.        IF UPDATE.DEFAULTS THEN _
  3007.          CALL DEFAULTU
  3008.       IF LIST.DIRECTORY THEN _
  3009.          LSET LIST.NEW.DATE$ = CHR$(VAL(MID$(CURRENT.DATE$,7,2))) + _
  3010.                                CHR$(VAL(MID$(CURRENT.DATE$,1,2))) + _
  3011.                                CHR$(VAL(MID$(CURRENT.DATE$,4,2)))
  3012. 10605 LSET USER.DOWNLOADS$ = MKI$(DOWNLOADS)
  3013.       LSET USER.UPLOADS$ = MKI$(UPLOADS)
  3014.          LSET TODAY.DL$ = MKS$(DL.TODAY!)
  3015.          LSET TODAY.BYTES$ = MKS$(BYTES.TODAY!)
  3016.          LSET DL.BYTES$ = MKS$(DLBYTES!)
  3017.          LSET UL.BYTES$ = MKS$(ULBYTES!)
  3018.       LSET ELAPSED.TIME$ = MKI$(Q!)
  3019.       IF ADJUSTED.SECURITY THEN _
  3020.          LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
  3021.       PUT 5,USER.FILE.INDEX
  3022.       SUBROUTINE.PARAMETER = 8
  3023.       CALL FILELOCK
  3024.       IF ACTIVE.USER.FILE$ <> ORIG.USER.FILE$ AND LOGGING.OFF  THEN _ 'KG102202
  3025.          ACTIVE.USER.FILE$ = ORIG.USER.FILE$ : _
  3026.          USER.FILE.INDEX = ORIG.USER.FILE.INDEX : _
  3027.          UPDATE.DEFAULTS = FALSE : _
  3028.          GOTO 10602
  3029. 10607 IF EXIT.TO.DOORS OR NOT LOGGING.OFF THEN _       'KG102202
  3030.          EXIT SUB
  3031.       IF MAX.PER.DAY <= 0 THEN _
  3032.          X = MINUTES.PER.SESSION! _
  3033.       ELSE X = (MAX.PER.DAY - Q!) : _
  3034.            X = -(X > 0) * X
  3035.       CALL QTPUT (CX$(3)+STR$(X)+CX$(6)+" min"+CX$(5)+" left for next call today",1)
  3036.       CALL QTPUT(CX$(6)+FIRST.NAME$ +CX$(2)+ ", Thanks for calling "+_
  3037. CX$(5)+RBBS.NAME$+CX$(3)+" and please call again!",1)
  3038.       IF NOT HIGHLIGHT.OFF THEN _
  3039.          CALL QTPUT (COLOR.RESET$,1)
  3040.       CALL DELAYIT (8 + BPS)
  3041.       END SUB
  3042. ' $SUBTITLE: 'DOSEXIT -- Setup to exit to DOS for SYSOP'
  3043. ' $PAGE
  3044. '  SUBROUTINE NAME    -- DOSEXIT
  3045. '
  3046. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3047. '                        COM.PORT$
  3048. '                        DOORS.TERMINAL.TYPE
  3049. '                        MULTI.LINK.PRESENT
  3050. '                        RBBS.BAT$
  3051. '                        REDIRECT.IO.METHOD
  3052. '                        USE.DEVICE.DRIVER$
  3053. '
  3054. '  OUTPUT PARAMETERS  -- Q                    NUMBER OF LINES TO WRITE OUT TO
  3055. '                                             RCTTY.BAT$
  3056. '                        B$()                 LINES TO WRITE OUT TO RCTTY.BAT$
  3057. '
  3058. '  SUBROUTINE PURPOSE -- SET UP B$() AND Q IN ORDER TO CALL "RBBSEXIT" AND
  3059. '                        EXIT TO DOS FOR THE REMOTE RBBS-PC SYSOP
  3060. '
  3061.       SUB DOSEXIT STATIC
  3062. 10934 IF MULTI.LINK.PRESENT AND _
  3063.          DOORS.TERMINAL.TYPE > 0 THEN _
  3064.          FF = 0 : _
  3065.          GOTO 10950
  3066.       A$(1) = "ECHO OFF"
  3067.       IF USE.DEVICE.DRIVER$ <> "" THEN _
  3068.          PORT$ = USE.DEVICE.DRIVER$ _
  3069.       ELSE PORT$ = "COM" + RIGHT$(COM.PORT$,1)
  3070.       IF REDIRECT.IO.METHOD THEN _
  3071.          FF = 5 : _
  3072.          A$(2) = "CTTY " + _
  3073.                  PORT$ : _
  3074.          A$(3) = DISK.FOR.DOS$ + _
  3075.                  "COMMAND" : _
  3076.          A$(4) = "CTTY CON" : _
  3077.          A$(5) = RBBS.BAT$ _
  3078.       ELSE FF = 3 : _
  3079.            A$(2) = DISK.FOR.DOS$ + _
  3080.                    "COMMAND >" + _
  3081.                    PORT$ + _
  3082.                    " <" + _
  3083.                    PORT$ : _
  3084.            A$(3) = RBBS.BAT$
  3085. 10950 SUBROUTINE.PARAMETER = 1
  3086.       CALL AMORPM
  3087.       CALL UPDTCALR ("Exited to DOS at " + TIM$,2)
  3088.       CALL QTPUT("RBBS-PC " + VERSION.ID$,1)
  3089.       CALL QTPUT("SYSOP in Remote Console Mode",1)
  3090.       CALL RBBSEXIT (A$(),FF)
  3091.       END SUB
  3092. ' $SUBTITLE: 'WORDINFILE -- Searches a file to find a word'
  3093. ' $PAGE
  3094. '  SUBROUTINE NAME    -- WORDINFILE
  3095. '
  3096. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3097. '                        FILNAME$      FILE TO SEARCH IN
  3098. '                        STRNG$        STRING TO SEARCH FOR
  3099. '
  3100. '  OUTPUT PARAMETERS  -- INFILE        WHETHER STRING FOUND IN FILE
  3101. '
  3102. '  SUBROUTINE PURPOSE -- SEARCHES FOR "STRNG$" IN FILE "FILNAME$."  USED TO
  3103. '                        LIMIT DOORS AND QUESTIONNAIRES TO THOSE SPECIFIED
  3104. '                        IN THEIR MENU FILES.  THE "STRNG$" IS CAPITALIZED
  3105. '                        BUT NOT THE LINES IN THE FILE, SO MUST BE EXACT
  3106. '                        CASE-SENSITIVE MATCH TO BE FOUND.  THE ONLY CHARACTER
  3107. '                        THAT CAN IMMEDIATELY PROCEED OR END A NAME TO BE
  3108. '                        FOUND MUST BE A BLANK.
  3109. '
  3110.       SUB WORDINFILE (FILNAME$,STRNG$,INFILE) STATIC
  3111. 10976 INFILE = FALSE
  3112.       CALL FINDIT (FILNAME$)
  3113.       IF NOT OK THEN _
  3114.          EXIT SUB
  3115.       X = 0
  3116.       CALL ALLCAPS (STRNG$)
  3117.       WHILE NOT EOF(2) AND X < 1
  3118.          LINE INPUT #2,A$
  3119.          Y = 1
  3120. 10978    X = INSTR(Y,A$,STRNG$)
  3121.          IF X < 1 THEN _
  3122.             GOTO 10980
  3123.          Y = X + 1
  3124.          IF X > 1 THEN _
  3125.             IF MID$(A$,X - 1,1) <> " " THEN _
  3126.                X = 0
  3127.          IF X > 0 THEN _
  3128.             L = LEN(STRNG$) : _
  3129.             IF LEN(A$) => (X + L) THEN _
  3130.                IF MID$(A$,X + L,1) <> " " THEN _
  3131.                   X = 0
  3132.          IF X = 0 THEN _
  3133.             GOTO 10978
  3134. 10980 WEND
  3135.       CLOSE 2
  3136.       INFILE = (X > 0)
  3137.       END SUB
  3138. ' $SUBTITLE: 'DOOREXIT -- Setup to exit to a "door"'
  3139. ' $PAGE
  3140. '  SUBROUTINE NAME    -- DOOREXIT
  3141. '
  3142. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3143. '                        MULTI.LINK.PRESENT
  3144. '                        NODE.ID$
  3145. '                        RBBS.BAT$
  3146. '                        Z$
  3147. '
  3148. '  OUTPUT PARAMETERS  -- Q                    NUMBER OF LINES TO WRITE OUT TO
  3149. '                                             RCTTY.BAT$
  3150. '                        B$()                 LINES TO WRITE OUT TO RCTTY.BAT$
  3151. '
  3152. '  SUBROUTINE PURPOSE -- SET UP B$() AND Q IN ORDER TO CALL "EXITRBBS" AND
  3153. '                        EXIT RBBS-PC TO INVOKE ANTOHER PROGRAM
  3154. '
  3155.       SUB DOOREXIT STATIC
  3156.       IF Z$ = "" OR _
  3157.          Z$ = "NONE" THEN _
  3158.          EXIT SUB
  3159.       CALL FINDIT (Z$)
  3160.       IF NOT OK THEN _
  3161.          A$ = "Missing door program" : _
  3162.          CALL UPDTCALR (A$ + " " + Z$,1) : _
  3163.          SNOOP = TRUE : _
  3164.          CALL LPRNT (A$,1) : _
  3165.          EXIT SUB
  3166. 10987 A$(1) = DISK.FOR.DOS$ + _
  3167.               "COMMAND /C " + _
  3168.               Z$ + _
  3169.               " " + _
  3170.               NODE.ID$
  3171.       A$(2) = RBBS.BAT$
  3172.       Z$ = LEFT$(Z$,LEN(Z$) - 4)
  3173.       IF TRANSFER.FUNCTION = 3 THEN _
  3174.          Y$ = "Registration" : _
  3175.       ELSE Y$ = Z$
  3176.       A$ = Y$ + _
  3177.            " door opened at " + _
  3178.            TIME$ + _
  3179.            " on " + _
  3180.            DATE$
  3181.       SUBROUTINE.PARAMETER = 5
  3182.       CALL TPUT
  3183.       CALL UPDTCALR (Z$ + " door opened! "+ TIME$,2)
  3184.       CALL QTPUT (Cx$(5)+"Takes approx 30 - 40 seconds.....",2)
  3185.       CLOSE 2
  3186.     DOORFILE$ =  "DORINFO"+ NODE.FILE.ID$ + ".DEF"
  3187.     CALL KILLWORK (DOORFILE$)
  3188.     EC = 0
  3189.       OPEN "O",2,"DORINFO" + _
  3190.                  NODE.FILE.ID$ + _
  3191.                  ".DEF"
  3192.       PRINT #2,RBBS.NAME$
  3193.       PRINT #2,SYSOP.FIRST.NAME$
  3194.       PRINT #2,SYSOP.LAST.NAME$
  3195.       IF LOCAL.USER THEN _                                           ' KG120906
  3196.          PRINT #2,"COM0" _                                           ' KG120906
  3197.       ELSE PRINT #2,COM.PORT$                                        ' KG120906
  3198.       B$ = MID$(BAUD.PARITY$,INSTR(BAUD.PARITY$," B"))
  3199.       PRINT #2,TALK.TO.MODEM.AT$;B$
  3200.       PRINT #2,NETWORK.TYPE
  3201.       IF GLOBAL.SYSOP THEN _
  3202.          PRINT #2,SYSOP.FIRST.NAME$ : _              ' KP101112
  3203.          PRINT #2,SYSOP.LAST.NAME$  _
  3204.       ELSE PRINT #2,ORIG.FIRST.NAME$ : _  
  3205.            PRINT #2,LAST.NAME$
  3206.       PRINT #2,CITY.STATE$
  3207.       PRINT #2,GR
  3208.       PRINT #2,USER.SECURITY.LEVEL
  3209.       CALL TIMEREMAIN (TIME.REMAINING!)
  3210.       PRINT #2,INT(TIME.REMAINING!)
  3211.       PRINT #2,FOSSIL
  3212.       CALL RBBSEXIT (A$(),2)
  3213.       END SUB
  3214. ' $SUBTITLE: 'RBBSEXIT -- Setup to exit RBBS'
  3215. ' $PAGE
  3216. '  SUBROUTINE NAME    -- RBBSEXIT
  3217. '
  3218. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3219. '                        LINE.ARA        Array of lines to write to batch file
  3220. '                        NUM.LINES       How many lines in array
  3221. '
  3222. '  OUTPUT PARAMETERS  -- RCTTY.BAT$
  3223. '
  3224. '  SUBROUTINE PURPOSE -- TO CREATE A BATCH FILE THAT CONTROL CAN BE PASSED TO
  3225. '                        AND TO EXIT RBBS-PC WHILE STILL KEEPING CARRIER UP
  3226. '
  3227.       SUB RBBSEXIT (LINE.ARA$(1),NUM.LINES) STATIC
  3228. 10992 CLOSE 2
  3229.       IF NUM.LINES = 0 THEN _
  3230.          GOTO 10994
  3231.       OPEN "O",2,RCTTY.BAT$
  3232.       FOR I = 1 TO NUM.LINES
  3233.          IF LINE.ARA$(I) <> "" THEN _
  3234.             PRINT #2,LINE.ARA$(I)
  3235.       NEXT
  3236.       CLOSE 2
  3237. 10994 CLOSE 3
  3238.       EXIT.TO.DOORS = TRUE
  3239.       IF NOT FOSSIL THEN _
  3240.          OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  3241.       IF NOT PRIVATE.DOOR THEN _
  3242.          CALL MLINIT (2)
  3243. 10996 CALL UPDATEU (TRUE)                    'KG102202
  3244.       CALL GETIME
  3245.       CALL SAVEPROF (1)
  3246.       IF NUM.LINES = 0 THEN _
  3247.          EXIT SUB
  3248.       CALL DELAYIT (9 + BPS)
  3249.       IF FOSSIL THEN _
  3250.          CALL FOSEXIT(COMPORT%)
  3251.       SYSTEM
  3252.       END SUB
  3253. ' $SUBTITLE: 'SETSECT -- Setup section prompts'
  3254. ' $PAGE
  3255. '  SUBROUTINE NAME    -- SETSECT         Doug Azzarito
  3256. '
  3257. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3258. '                        MENU.INDEX      2 = user is in MAIN section
  3259. '                                        3 = user is in FILE section
  3260. '                                        4 = user is in UTIL section
  3261. '                                        6 = user is in LIBR section
  3262. '
  3263. '  OUTPUT PARAMETERS  -- SECTION$        4 character section name
  3264. '                        ACTIVE.MENU$    1 character section name
  3265. '                        SECTION.PROMPT$ Section name (if SHOW.SECTION config)
  3266. '                        COMMAND.PROMPT$ Command input prompt string
  3267. '                        SECTION.OPTS$   List of options valid in this sect
  3268. '                        INVALID.OPTS$   List of options invalid in this sect
  3269. '                        SUB.SECTION     Index into security array for section
  3270. '
  3271. '  SUBROUTINE PURPOSE -- TO BUILD THE PROMPT STRINGS FOR THE CURRENT SECTION
  3272. '
  3273.       SUB SETSECT STATIC
  3274. 12000 ON MENU.INDEX GOTO 12001, 12010,12005,12020,12001,12015
  3275. 12001 EXIT SUB
  3276. 12005 LSET SECTION$ = "FILE"
  3277.       SECTION.OPTS$ = FILE.OPTS$
  3278.       INVALID.OPTS$ = INVALID.FILE.OPTS$
  3279.       SUB.SECTION = BEG.FILE
  3280.       GOTO 12025
  3281. 12010 LSET SECTION$ = "MAIN"
  3282.       SECTION.OPTS$ = MAIN.OPTS$
  3283.       INVALID.OPTS$ = INVALID.MAIN.OPTS$
  3284.       SUB.SECTION = BEG.MAIN
  3285.       GOTO 12025
  3286. 12015 LSET SECTION$ = "LIBR"
  3287.       SECTION.OPTS$ = LIBRARY.OPTS$
  3288.       INVALID.OPTS$ = INVALID.LIBRARY.OPTS$
  3289.       SUB.SECTION = BEG.LIBRARY
  3290.       GOTO 12025
  3291. 12020 LSET SECTION$ = "UTIL"
  3292.       SECTION.OPTS$ = UTIL.OPTS$
  3293.       INVALID.OPTS$ = INVALID.UTIL.OPTS$
  3294.       SUB.SECTION = BEG.UTIL
  3295. 12025 ACTIVE.MENU$ = LEFT$(SECTION$,1)
  3296.       IF SHOW.SECTION THEN _
  3297.          SECTION.PROMPT$ = SECTION$ _
  3298.       ELSE SECTION.PROMPT$ = "Your"
  3299.       IF COMMANDS.IN.PROMPT=0 THEN _
  3300.           SECTION.OPTS$ = ""
  3301.       COMMAND.PROMPT$ = SECTION.PROMPT$ + _
  3302.                         " command" + _
  3303.                         SECTION.OPTS$
  3304.       END SUB
  3305. ' $SUBTITLE: 'UNTILRIGHT - subroutine to ask question until answer okay'
  3306. ' $PAGE
  3307. '
  3308. '  SUBROUTINE NAME    -- UNTILRIGHT
  3309. '
  3310. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3311. '                        QUES$         QUESTION TO BE ASKED THE USER
  3312. '                        ANS$          LOCATION TO STORE THE ANSWER
  3313. '                        MIN.LEN       MINIMUM LENGTH OF ANSWER
  3314. '                        MAX.LEN       MAX LENGTH OF ANSWER
  3315. '
  3316. '  OUTPUT PARAMETERS  -- ANS$          RESPONSE TO THE QUESTION WHICH THE
  3317. '                                      CALLERS SAYS IS CORRECT
  3318. '
  3319. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ASK A USER A QUESTION UNTIL THE CALLER
  3320. '                        RESPONDS THAT THE ANSWER IS CORRECT
  3321. '
  3322.       SUB UNTILRIGHT (QUES$,ANS$,MIN.LEN,MAX.LEN) STATIC
  3323. 12880 SUBROUTINE.PARAMETER = 1
  3324.       A$ = QUES$
  3325.       CALL TGET
  3326.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3327.          GOTO 12882
  3328.       IF Q = 0 THEN _
  3329.          GOTO 12880
  3330.       IF LEN(B$(1)) > MAX.LEN THEN _
  3331.          CALL QTPUT (STR$(MAX.LEN) + " chars max",1) : _
  3332.          GOTO 12880_
  3333.       ELSE IF LEN(B$(1)) < MIN.LEN THEN _
  3334.               CALL QTPUT (STR$(MIN.LEN) + " chars min",1) : _
  3335.               GOTO 12880
  3336.       ANS$ = B$(1)
  3337.       A$ = B$(1) + _
  3338.            ", right ([Y],N)"
  3339.       TURBO.KEY = -TURBO.KEY.USER
  3340.       SUBROUTINE.PARAMETER = 1
  3341.       CALL TGET
  3342.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3343.          GOTO 12882
  3344.       IF NO THEN _
  3345.          GOTO 12880
  3346.       CALL ALLCAPS (ANS$)
  3347.       EXIT SUB
  3348. 12882 ANS$ = "GUEST"
  3349.       END SUB
  3350. ' $SUBTITLE: 'LOGERROR - subroutine to log errors to CALLERS file'
  3351. ' $PAGE
  3352. '
  3353. '  SUBROUTINE NAME    -- LOGERROR
  3354. '
  3355. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3356. '                               ERR           ERROR NUMBER DETECTED BY BASIC
  3357. '                               ERL           LAST LINE NUMBER ENCOUNTERED
  3358. '                                             PRIOR TO ENCOUNTERNING ERROR
  3359. '
  3360. '  OUTPUT PARAMETERS  -- NONE
  3361. '
  3362. '  SUBROUTINE PURPOSE -- TO SET UP A STRING TO WRITE TO THE CALLERS LOG
  3363. '                        INDICATING THE DATE, TIME, ERROR, AND ERROR LINE
  3364. '
  3365.       SUB LOGERROR STATIC
  3366. 13660 IX = ERR
  3367.       IF ERR < 1 THEN _
  3368.          IX = EC
  3369.       CALL UPDTCALR("+++ Error " + _
  3370.            STR$(IX) + _
  3371.            " line " + _
  3372.            STR$(ERL) + _
  3373.            " at " + _
  3374.            TIME$ + _
  3375.            " on " + _
  3376.            DATE$,2)
  3377.       END SUB
  3378. '
  3379. ' $SUBTITLE: 'CHECKRATIO - subroutine to print ul/dl ratio'
  3380. ' $PAGE
  3381. '
  3382. '  SUBROUTINE NAME    -- CHECKRATIO
  3383. '
  3384. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3385. '                          TELL.USER          TELL USER THEIR RATIO
  3386. '                          DOWNLOADS          FILES DOWNLOADED
  3387. '                          DLBYTES!           BYTES DOWNLOADED
  3388. '                          UPLOADS            FILES UPLOADED
  3389. '                          ULBYTES!           BYTES UPLOADED
  3390. '
  3391. '  OUTPUT PARAMETERS  -- OK  - IF IT IS OK FOR THE USER TO DOWNLOAD
  3392. '
  3393. '  SUBROUTINE PURPOSE -- TO PRINT THE USERS UPLOAD TO DOWNLOAD RATIO
  3394. '                        AND TO DETERMINE IF THE USERS HAS VIOLATED
  3395. '                        THEIR UPLOAD TO DOWNLOAD RESTRICTION
  3396. '
  3397. '
  3398.       SUB CHECKRATIO (TELL.USER) STATIC
  3399.       OK = TRUE
  3400. 20096 'IF NOT ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
  3401.       '   GOTO 20110
  3402. '      IF RATIO.RESTRICTION# = 0 THEN _
  3403. '         GOTO 20110
  3404. '
  3405. ' DETERMINE METHOD OF RATIO CHECKING TO BE PERFORMED
  3406. '
  3407.       IF BYTE.METHOD = 1 OR BYTE.METHOD = 3 THEN _
  3408.          METHOD$ = "Bytes" : _
  3409.          UL.WORK# = ULBYTES! : _
  3410.          DL.WORK# = DLBYTES!
  3411.       IF BYTE.METHOD = 0 OR BYTE.METHOD = 2 THEN _
  3412.          METHOD$ = "Files" : _
  3413.          UL.WORK# = UPLOADS : _
  3414.          DL.WORK# = DOWNLOADS
  3415.       IF BYTE.METHOD = 2 THEN _
  3416.          TODAY# = RATIO.RESTRICTION# - DL.TODAY!
  3417.       IF BYTE.METHOD = 3 THEN _
  3418.          TODAY# = RATIO.RESTRICTION# - BYTES.TODAY! - NUM.DNLD.BYTS!
  3419. '
  3420.       RATIO# = INT(DL.WORK# / 1)
  3421.       RATIO.SUFFIX$ = ":0"
  3422.       IF UL.WORK# > 0 THEN _
  3423.          RATIO# = INT(DL.WORK# / UL.WORK#) : _
  3424.          RATIO.SUFFIX$ = ":1"
  3425.       IF BYTE.METHOD < 2 THEN _
  3426. A$ =  CX$(3)+"Todays Downloaded Files: " + CX$(5)+STR$(DL.TODAY!)+CRLF$ + _
  3427. CX$(2)+  "Number of Bytes today  : " + CX$(4)+STR$(BYTES.TODAY!) +CRLF$ :_
  3428. A$ = A$ + METHOD$ +CX$(1)+ " Downloaded: "+CX$(2) + STR$(DL.WORK#)+CRLF$+ _
  3429.                    CX$(5)+ "Uploaded  : "+CX$(3) + _
  3430.               STR$(UL.WORK#)+CRLF$ : _
  3431.          A$ = A$ + CX$(6)+ "Ratio  : " +CX$(1)+ _
  3432.               STR$(RATIO#) + _
  3433.               RATIO.SUFFIX$ +CX$(7)+CRLF$ : _
  3434.          SUBROUTINE.PARAMETER = 5 : _
  3435.          CALL TPUT
  3436.       IF BYTE.METHOD > 1 THEN _
  3437.          A$ = "Today Downloaded Files: " + STR$(DL.TODAY!)+CRLF$ + _
  3438.               "Bytes:" + STR$(BYTES.TODAY!)+CRLF$ : _
  3439.          SUBROUTINE.PARAMETER = 5 : _
  3440.          CALL TPUT : _
  3441.          CALL SKIPLINE (1)
  3442. IF RATIO.RESTRICTION# = 0 THEN _
  3443.    GOTO 20110
  3444. '
  3445. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3446. '
  3447. 20100 IF NOT (RATIO.RESTRICTION# > 0 AND TELL.USER) THEN _
  3448.          EXIT SUB
  3449.       IF BYTE.METHOD <= 1 THEN _
  3450.          GOTO 20105
  3451.       IF TODAY# <= 0 THEN _
  3452.          A$ = "Sorry, Daily download limit of" + _
  3453.               STR$(RATIO.RESTRICTION#) + " " + _
  3454.               METHOD$ + " Reached" : _
  3455.          OK = FALSE _
  3456.       ELSE A$ = "Download balance remaining:" + _
  3457.                 STR$(RATIO.RESTRICTION#) + _
  3458.                 " " + _
  3459.                 METHOD$ : _
  3460.            OK = TRUE
  3461.       SUBROUTINE.PARAMETER = 5
  3462.       CALL TPUT
  3463.       CALL SKIPLINE(1)
  3464.       EXIT SUB
  3465. '
  3466. 20105 IF RATIO# >= RATIO.RESTRICTION# THEN _
  3467.          OK = FALSE : _
  3468.          A$ = "Sorry, DL/UL ratio of" + _
  3469.               STR$(RATIO.RESTRICTION#) + _
  3470.               ":1 " + _
  3471.               METHOD$ + " exceeded" : _
  3472.          SUBROUTINE.PARAMETER = 5 : _
  3473.          CALL TPUT : _
  3474.          A$ = "Minimum upload of" + _
  3475.               STR$(INT(((DL.WORK# - (UL.WORK# * RATIO.RESTRICTION#)) _
  3476.               / RATIO.RESTRICTION#) + 1)) + _
  3477.               + " " + METHOD$ + " required before You may download" _
  3478.       ELSE A$ = "Balance remaining before upload required:" + _
  3479.                 STR$(INT((UL.WORK# * RATIO.RESTRICTION#)-DL.WORK#)) + _
  3480.                 " " + METHOD$
  3481.       SUBROUTINE.PARAMETER = 5
  3482.       CALL TPUT
  3483.       CALL SKIPLINE (1)
  3484. 20110 END SUB
  3485. ' $SUBTITLE: 'GETARC - subroutine to get what files to verbose list'
  3486. ' $PAGE
  3487. '
  3488. '  SUBROUTINE NAME    -- GETARC
  3489. '
  3490. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3491. '                         Q                     NUMBER OF ENTRIES TYPED
  3492. '                         B$()                  ENTRIES TYPED
  3493. '
  3494. '  OUTPUT PARAMETERS  --
  3495. '
  3496. '  SUBROUTINE PURPOSE --  PROCESS THE V)ERBOSE ARC LIST COMMAND.
  3497. '                         TAKES WHAT USER TYPES AND TRIES TO LIST IT.
  3498. '
  3499.       SUB GETARC STATIC
  3500.       IF Q > 1 THEN _
  3501.          B = 2 : _
  3502.          GOTO 20142
  3503. 20141 A$ = "Enter Compressed file(s) to list"
  3504.       SUBROUTINE.PARAMETER = 1
  3505.       CALL TGET
  3506.       IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _
  3507.          EXIT SUB
  3508.       B = 1
  3509. 20142 LAST.INDEX = Q
  3510.       ANS.INDEX = B
  3511.       VIOLATION$ = "View ARC"
  3512.       FOR ARC.INDEX = ANS.INDEX TO LAST.INDEX
  3513.          GOSUB 20143
  3514.       NEXT
  3515.       EXIT SUB
  3516. '****************************** ROUTINE TO CHECK FILE TYPE **********
  3517. ' Depending on the File Extension we will decide what Comression utility
  3518. ' to use...as of this date *.ZOO and *.DWC file are not supported but will
  3519. ' be added here soon !     -Pete-
  3520. '
  3521. 20143 Z$ = B$(ARC.INDEX)
  3522.       CALL ALLCAPS (Z$)
  3523.       CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)
  3524.      IF EXT$ = "ARC"_
  3525.      OR EXT$ = "PAK"_
  3526.      OR EXT$ = "ZOO" _
  3527.      OR EXT$ = "ZIP" _
  3528.      OR EXT$ = "DWC" THEN _
  3529.              ARK = TRUE ELSE _
  3530.         CALL QTPUT ("Only ARC,PAK,ZOO,ZIP or DWC  files can be viewed",1) : _
  3531.               RETURN
  3532. '
  3533.       LAST.EXT$ = EXT$
  3534.       FILE.NAME.HOLD$ = Z$
  3535.       FILE.NAME$ = Z$
  3536.       CALL BADFILE (PREFIX$,BAD.FILE.NAME.INDEX)
  3537.       ON BAD.FILE.NAME.INDEX GOTO 20144,20146,20147
  3538. 20144 CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  3539.       ON BAD.FILE.NAME.INDEX GOTO 20145,20146,20147
  3540. 20145 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + (NOT SYSOP),TRUE)
  3541.       IF OK THEN _
  3542.          GOTO 20148
  3543. 20146 Z$ = B$(ARC.INDEX) + _
  3544.            " not found!"
  3545.       CALL UPDTCALR (Z$,2)
  3546.       A$ = Z$ + _
  3547.            " Type correct filename" + PRESS.ENTER.EXPERT$
  3548.       SUBROUTINE.PARAMETER = 1
  3549.       CALL TGET
  3550.       IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _
  3551.          RETURN
  3552.       B$(ARC.INDEX) = B$(1)
  3553.       GOTO 20143
  3554. 20147 CALL SVIOLATION
  3555.       IF DENY.ACCESS THEN _
  3556.          EXIT SUB
  3557.       GOTO 20146
  3558. 20148 CALL QTPUT(FILE.NAME.HOLD$ + " has these files",1)
  3559.       CALL VIEWARC      ' This is in RBBSSUB4.BAS
  3560.       CALL VIEWTXT        'Pete Eibl RBBSSUB1.BAS
  3561. '      CALL DLVIEWARC      'Pete Eibl RBBSSUB1.BAS
  3562.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3563.          ARC.INDEX = LAST.INDEX + 1
  3564.       RETURN
  3565.       END SUB
  3566. ' $SUBTITLE: 'BADNAME - subroutine to find bad file names'
  3567. ' $PAGE
  3568. '
  3569. '  SUBROUTINE NAME    -- BADNAME
  3570. '
  3571. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3572. '                        ACTIVE.MESSAGE.FILE$
  3573. '                        ACTIVE.USER.FILE$
  3574. '                        CALLERS.FILE$
  3575. '                        COMMENTS.FILE$
  3576. '                        CONFIG.FILEANAME$
  3577. '                        MAIN.MESSAGE.BACKUP$
  3578. '                        MAIN.MESSAGE.FILE$
  3579. '                        MAXIMUM.VIOLATIONS
  3580. '                        PASSWORDS.FILE$
  3581. '                        RBBS.BAT$
  3582. '                        RCTTY.BAT$
  3583. '                        SUBDIR$()
  3584. '                        SUBDIR.INDEX
  3585. '                        VIOLATION$
  3586. '                        VIOLATIONS.THIS.SESSION
  3587. '                        Z$                          NAME OF FILE
  3588. '
  3589. '  OUTPUT PARAMETERS  -- BAD.FILE.NAME.INDEX         1 = FILE NAME IS OK
  3590. '                                                    2 = SECURITY BREACH TRIED
  3591. '                        VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  3592. '                        FILENAME$                   NAME OF FILE
  3593. '
  3594. '  SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
  3595. '                        TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
  3596. '                        SECURITY
  3597. '
  3598.       SUB BADNAME (BAD.FILE.NAME.INDEX) STATIC
  3599. '
  3600. ' *
  3601. ' *  TEST FOR SYSTEM FILE ATTEMPT                                             *
  3602. ' *
  3603. 20235 BAD.FILE.NAME.INDEX = 1
  3604.       Z$ = FILE.NAME$
  3605.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.MESSAGE.FILE$,3,(LEN(ACTIVE.MESSAGE.FILE$) - 2))) THEN _
  3606.          GOTO 20236
  3607.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$,3,(LEN(ACTIVE.USER.FILE$) - 2))) THEN _
  3608.          GOTO 20236
  3609.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$ + ".BAK",3,(LEN(ACTIVE.USER.FILE$ + ".BAK") - 2))) THEN _
  3610.          GOTO 20236
  3611.       IF LEN(CALLERS.FILE$) > 2 THEN _
  3612.          IF INSTR(3,FILE.NAME$,MID$(CALLERS.FILE$,3,(LEN(CALLERS.FILE$) - 2))) THEN _
  3613.             GOTO 20236
  3614.       IF INSTR(3,FILE.NAME$,MID$(COMMENTS.FILE$,3,(LEN(COMMENTS.FILE$) - 2))) THEN _
  3615.          GOTO 20236
  3616.       IF INSTR(3,FILE.NAME$,MID$(FILESEC.FILE$,3,(LEN(FILESEC.FILE$) - 2))) THEN _
  3617.          GOTO 20236
  3618.       IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.BACKUP$,3,(LEN(MAIN.MESSAGE.BACKUP$) - 2))) THEN _
  3619.          GOTO 20236
  3620.       IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.FILE$,3,(LEN(MAIN.MESSAGE.FILE$) - 2))) THEN _
  3621.          GOTO 20236
  3622.       IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$,3,(LEN(MAIN.USER.FILE$) - 2))) THEN _
  3623.          GOTO 20236
  3624.       IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$ + ".BAK",3,(LEN(MAIN.USER.FILE$ + ".BAK") - 2))) THEN _
  3625.          GOTO 20236
  3626.       IF INSTR(3,FILE.NAME$,MID$(PASSWORDS.FILE$,3,(LEN(PASSWORDS.FILE$) - 2))) THEN _
  3627.          GOTO 20236
  3628.       IF INSTR(3,FILE.NAME$,MID$(RBBS.BAT$,3,(LEN(RBBS.BAT$) - 2))) THEN _
  3629.          GOTO 20236
  3630.       IF INSTR(3,FILE.NAME$,MID$(RCTTY.BAT$,3,(LEN(RCTTY.BAT$) - 2))) THEN _
  3631.          GOTO 20236
  3632.       CALL BRKFNAME (CONFIG.FILENAME$,DR$,PREFIX$,EXTENSION$,FALSE)
  3633.       IF INSTR(3,FILE.NAME$,MID$(CONFIG.FILENAME$,LEN(DR$) + 1)) THEN _
  3634.          GOTO 20236
  3635.       EXIT SUB
  3636. 20236 BAD.FILE.NAME.INDEX = 2
  3637.       END SUB
  3638. ' $SUBTITLE: 'BRKFNAME - subroutine to split file name into components'
  3639. ' $PAGE
  3640. '
  3641. '  SUBROUTINE NAME    -- BRKFNAME
  3642. '
  3643. '  INPUT PARAMETERS   -- PARAMETER                    MEANING
  3644. '                        FILENAME$        FULL NAME OF FILE
  3645. '                        FOR.JOINING      TRUE IF WANT PARTS FORMATTED FOR
  3646. '                                           FORMING FILE NAMES
  3647. '  OUTPUT PARAMETERS  -- DRVPATH$         DRIVE AND PATH
  3648. '                        PREFIX$          PREFIX OF FILE NAME
  3649. '                        EXTENSION$       EXTENSION OF FILE NAME
  3650. '
  3651. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  3652. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  3653. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  3654. '
  3655. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  3656. '
  3657. '  SUBROUTINE PURPOSE -- TO BREAK A FILE NAME INTO ITS COMPONENT PARTS
  3658. '                        OF DRIVE/PATH, PREFIX, AND EXTENSION
  3659. '
  3660. '
  3661.       SUB BRKFNAME (FILENAME$,DRVPATH$,PREFIX$,EXTENSION$,FOR.JOINING) STATIC
  3662. 20282 CALL ALLCAPS (FILENAME$)
  3663.       DRVPATH$ = ""
  3664.       PREFIX$ = ""
  3665.       EXTENSION$ = ""
  3666.       CALL TRIMTRAIL (FILENAME$,"\")
  3667.       L = LEN(FILENAME$)
  3668.       IF L < 1 THEN _
  3669.          EXIT SUB
  3670.       CALL FINDLAST (FILENAME$,"\",X,Y)
  3671.       IF X < 1 THEN _
  3672.          IF MID$(FILENAME$,2,1) = ":" THEN _
  3673.             DRVPATH$ = LEFT$(FILENAME$,1) : _
  3674.             S = 3 _
  3675.          ELSE S = 1 _
  3676.       ELSE DRVPATH$ = LEFT$(FILENAME$,X-1) : _
  3677.            S = X + 1
  3678.       X = INSTR(FILENAME$ + ".",".")
  3679.       IF X < L THEN _
  3680.          EXTENSION$ = MID$(FILENAME$,X + 1,3)
  3681.       IF S <= L THEN _
  3682.          IF X >= S THEN _
  3683.             PREFIX$ = MID$(FILENAME$,S,X - S)
  3684.       IF NOT FOR.JOINING THEN _
  3685.          EXIT SUB
  3686.       IF LEN(DRVPATH$) = 1 THEN _
  3687.          DRVPATH$ = DRVPATH$ + _
  3688.                     ":"
  3689.       IF INSTR(DRVPATH$,"\") > 0 THEN _
  3690.          DRVPATH$ = DRVPATH$ + _
  3691.                     "\"
  3692.       IF LEN(EXTENSION$) > 0 THEN _
  3693.          EXTENSION$ = "." + _
  3694.                       EXTENSION$
  3695.       END SUB
  3696. ' $SUBTITLE: 'WILDCARD -- Matches string to a pattern'
  3697. ' $PAGE
  3698. '  SUBROUTINE NAME    -- WILDCARD
  3699. '
  3700. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3701. '                        PATTERN$           PATTERN TO CHECK
  3702. '                        STRNG$             STRING TO FIE
  3703. '
  3704. '  OUTPUT PARAMETERS  -- OK                 TRUE IF MATCH FOUND
  3705. '                                           FALSE IF NO MATCH WAS FOUND
  3706. '
  3707. '  SUBROUTINE PURPOSE  DETERMINE WHETHER A STRING IS AN INSTANCE IN A PATTERN
  3708. '                      SUPPORTED PATTERNS ARE ONLY "?" WHICH REQUIRES A
  3709. '                      CHARACTER BUT CAN BE ANY, AND "*" WHICH MATCHES ANY-
  3710. '                      THING, INCLUDING A NULL STRING.  ANYTHING ELSE IN A
  3711. '                      MUST BE AN EXACT MATCH.
  3712. '
  3713. '
  3714.       SUB WILDCARD (PATTERN$,STRNG$) STATIC
  3715. 20285 OK = TRUE
  3716.       K = 0
  3717.       L = LEN(STRNG$)
  3718. 20286 K = K + 1
  3719.       IF K > L THEN _
  3720.          GOTO 20288
  3721.       B$ = MID$(PATTERN$,K,1)
  3722.       IF B$ = "*" THEN _
  3723.          EXIT SUB
  3724. 20287 IF B$ <> "?" AND MID$(STRNG$,K,1) <> B$ THEN _
  3725.          OK = FALSE : _
  3726.          EXIT SUB
  3727.       GOTO 20286
  3728. 20288 IF L < LEN(PATTERN$) AND MID$(PATTERN$,L + 1,1) <> "*" THEN _
  3729.          OK = FALSE
  3730.       END SUB
  3731. ' $SUBTITLE: 'ABORTLOGOFF -- RBBS-PC common routine to Abort Autologoff'
  3732. ' $PAGE
  3733. '
  3734. '
  3735.       SUB ABORTLOGOFF STATIC
  3736.       ON SUBROUTINE.PARAMETER GOTO 20300,20326
  3737. '
  3738. ' *
  3739. ' *  COMMON INPUT ROUTINE                                                     *
  3740. ' *
  3741. '
  3742. 20300 CALL CARRIER
  3743.      IF SUBROUTINE.PARAMETER = -1 THEN _
  3744.         EXIT SUB
  3745.      LINES.PRINTED = 0
  3746.      DISPLAY.AS.UNIT = FALSE
  3747.      TOA! = FRE("A")
  3748.   IF AUTO.END =0  THEN _   'pe 04/08/89
  3749.  EXIT SUB
  3750. TEMP! = AUTO.LOGOFF!
  3751. AUTO.LOGOFF! = 25
  3752.       CALL SETABORT (AUTO.LOGOFF!,15)
  3753.      AUTO.WARN! = AUTO.LOGOFF! - 30
  3754.      A = 0
  3755.      B = 0
  3756.      C = 0
  3757.      Q = 1
  3758.      PARM = 0
  3759.      EOL = FALSE
  3760.      YES = FALSE
  3761.      B$ = ""
  3762.      SLEEP.WARN = TRUE
  3763.      NO = FALSE
  3764.      CALL COLORPMT (A$)
  3765.      A$ = A$ + _
  3766.           MID$("! !  ",2*TURBO.KEY+1,2)
  3767.      SUBROUTINE.PARAMETER = 4
  3768.      STOP.SAVE = STOP.INTERRUPTS
  3769.      STOP.INTERRUPTS = TRUE
  3770.      CALL TPUT
  3771.      STOP.INTERRUPTS = STOP.SAVE
  3772.      IF SUBROUTINE.PARAMETER = -1 THEN _
  3773.         EXIT SUB
  3774. 20323 IF PROMPT.BELL THEN _
  3775.         IF LOCAL.USER THEN _
  3776.            BEEP_
  3777.         ELSE CALL PUTCOM(BELL.RINGER$)
  3778. 20325 CALL CARRIER
  3779.      IF SUBROUTINE.PARAMETER = -1 THEN _
  3780.         EXIT SUB
  3781.      IF (NOT FORCE.KEYBOARD) AND LEN(COMMPORT.STACK$) > 0 THEN _
  3782.         Y$ = LEFT$(COMMPORT.STACK$,1) : _
  3783.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  3784.         GOTO 20341
  3785.      IF LOCAL.USER THEN _
  3786.         CALL FINDFUNC: _
  3787.         IF SUBROUTINE.PARAMETER < 0 THEN _
  3788.            EXIT SUB _
  3789.         ELSE GOTO 20326
  3790.      CALL EOFCOMM (CHAR%)
  3791.      IF CHAR% <> -1 THEN _
  3792.         CALL GETCOM(Y$) : _
  3793.         IF SUBROUTINE.PARAMETER = -1 THEN _
  3794.            EXIT SUB _
  3795.         ELSE GOTO 20341
  3796.      CALL FINDTIME (TI!)
  3797.      IF TI! > AUTO.WARN! THEN _
  3798.         IF TI! > AUTO.LOGOFF! THEN _
  3799.            CALL UPDTCALR ("Used AutoLogoff",1) :_
  3800.            SUBROUTINE.PARAMETER = -1 : _
  3801.            EXIT SUB _
  3802.         ELSE IF SLEEP.WARN THEN _
  3803.                 SLEEP.WARN = FALSE : _
  3804.                 A$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _
  3805.                 CALL RINGCALLER
  3806.      CALL FINDFUNC
  3807.      IF SUBROUTINE.PARAMETER < 0 THEN _
  3808.         EXIT SUB
  3809. 20326 CALL QTPUT (".",0)
  3810.       Call DELAYIT (1)
  3811.       Y$ = KEY.PRESSED$
  3812.      IF Y$ <> "" THEN _
  3813.         GOTO 20345
  3814.      SEND.REMOTE = TRUE
  3815.      CALL GOIDLE
  3816.      GOTO 20325
  3817. 20341 SEND.REMOTE = REMOTE.ECHO
  3818.      IF TEST.PARITY THEN _
  3819.         GOTO 20342
  3820.      IF Y$ = CHR$(127) THEN _
  3821.         GOTO 20435
  3822.      GOTO 20345
  3823. 20342 IF Y$ = "" THEN _
  3824.         Y$ = " "
  3825.      IF ASC(Y$) = 141 THEN _
  3826.         OUT LINE.CONTROL.REGISTER,&H1A : _
  3827.         EIGHT.BIT = FALSE : _
  3828.         TEST.PARITY = FALSE : _
  3829.         GR = FALSE
  3830.      Y$ = CHR$(ASC(Y$) AND 127)
  3831. 20345 X$ = Y$                                  'KG101503
  3832.      IF INSTR(LINEEDIT.CHK$,Y$) > 5 _
  3833.         GOTO 20435
  3834.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  3835.         GOTO 20325
  3836.      IF Y$ = "^" THEN _
  3837.         GOTO 20325
  3838.      IF Y$ = CARRIAGE.RETURN$ THEN _
  3839.         GOTO 20347 _
  3840.      ELSE GOSUB 20350
  3841.      IF TURBO.KEY < 1 THEN _
  3842.         GOTO 20346
  3843.      IF Y$ = " " THEN _
  3844.         Y$ = ""
  3845.      IF Y$ <> "/" THEN _
  3846.         B$ = Y$ : _
  3847.         Y$ = CARRIAGE.RETURN$ : _
  3848.         X$ = Y$ : _                       'KG101601
  3849.         GOTO 20347
  3850.      TURBO.KEY = 0
  3851.      GOTO 20325
  3852. 20346 IF LEN(B$) => 254 THEN _
  3853.         A$ = "Input too long!" : _
  3854.         SUBROUTINE.PARAMETER = 5 : _
  3855.         CALL TPUT : _
  3856.         IF SUBROUTINE.PARAMETER = -1  THEN _
  3857.            EXIT SUB _
  3858.         ELSE GOTO 20300
  3859.      B$ = B$ + _
  3860.           Y$
  3861.      GOTO 20325
  3862. 20347 TURBO.KEY = FALSE          ' Carriage Return Handler
  3863.      HIDDEN = FALSE
  3864.      IF NO.ADVANCE THEN _
  3865.         NO.ADVANCE = FALSE : _
  3866.         GOTO 20375 _
  3867.      ELSE CALL LPRNT (CRLF$,0) : _
  3868.           GOSUB 20351 : _
  3869.           GOTO 20370
  3870. 20350 IF LOGON.ACTIVE THEN _                                          ' KG101503
  3871.         IF (Y$ = " " OR Y$ = ";") AND _                              ' KG101503
  3872.            RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _        ' KG101503
  3873.               PARM = PARM + 1 : _                                    ' KG101503
  3874.               LOGON.ACTIVE = (PARM < 3) : _                          ' KG101503
  3875.               HIDDEN = (PARM = 2) : _                                ' KG101503
  3876.               CALL LPRNT(X$,0) : _                                   ' KG101503
  3877.               GOTO 20351                                              ' KG1020303
  3878. 'Was IF HIDDEN AND LOCAL.USER THEN.....
  3879.      IF HIDDEN THEN _                       'PE 11/04/88
  3880.         X$ = "."                                                     ' KG101503
  3881.      CALL LPRNT(X$,0)                                                ' KG101503
  3882. 20351 IF NOT SEND.REMOTE THEN _
  3883.         RETURN
  3884. 20353 CALL PUTCOM (X$)
  3885.      RETURN
  3886. 20370 IF SEND.REMOTE THEN _
  3887.         IF LINE.FEEDS THEN _
  3888.            CALL PUTCOM (LINE.FEED$)
  3889. 20375 IF LEN(B$) > 4000 THEN _
  3890.         A$ = "Try again, " + _
  3891.              FIRST.NAME$ : _
  3892.         SUBROUTINE.PARAMETER = 5 : _
  3893.         CALL TPUT : _
  3894.         IF SUBROUTINE.PARAMETER = -1 THEN _
  3895.            EXIT SUB _
  3896.         ELSE GOTO 20300
  3897.      IF PARSE.OFF THEN _
  3898.         PARSE.OFF = FALSE : _
  3899.         GOTO 20420
  3900.      CALL PARSEIT
  3901.      IF Q = 1 THEN _
  3902.         GOTO 20422                  'KG012602
  3903.      GOTO 20425
  3904. 20420 B$(1) = B$
  3905.      Q = 1
  3906. 20422  IF B$ = "" THEN _              'KG012602
  3907.         Q = 0 : _
  3908.       HIDDEN = FALSE : _       'KG101502
  3909. AUTO.LOGOFF! = TEMP!
  3910.         EXIT SUB
  3911. 20425 IF LEN(B$) < 4 THEN _
  3912.         X$ = LEFT$(B$,3): _
  3913.         CALL ALLCAPS (X$) : _
  3914.         IF X$ = "Y" OR X$ = "YES" THEN _
  3915.            YES = TRUE _
  3916.         ELSE IF X$ = "N" OR X$ = "NO" OR X$ = "A" THEN _
  3917.                 NO = TRUE _
  3918.              ELSE IF X$ = "RE" THEN _
  3919.                      REPLY = TRUE : _
  3920.                      EXIT SUB _
  3921.                   ELSE IF X$ = "K" THEN _
  3922.                           KILL.MESSAGE = TRUE : _
  3923.                        EXIT SUB
  3924.      IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
  3925.         NON.STOP = TRUE : _
  3926.         B$(Q) = "" : _
  3927.         IF Q > 1 THEN _
  3928.            Q = Q-1
  3929.      FORCE.KEYBOARD = FALSE
  3930.      HIDDEN = FALSE             'KG101503
  3931.      EXIT SUB
  3932. 20435 IF LEN(B$) = 0 THEN _
  3933.         GOTO 20325
  3934.      IF LOGON.ACTIVE THEN _
  3935.         IF INSTR(" ;",RIGHT$(B$,1)) > 0 THEN _
  3936.            PARM = PARM - 1
  3937.      B$ = LEFT$(B$,LEN(B$)-1)
  3938.      CALL LPRNT(LOCAL.BACKSPACE$,0)
  3939.      IF SEND.REMOTE THEN _
  3940.         CALL PUTCOM(BACKSPACE$)
  3941.      GOTO 20325
  3942. AUTO.LOGOFF! = TEMP!
  3943.      END SUB